f62ebe3...master · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

.ghcideleted−16

since splitsnapshots

unifiedsplit

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

1−:set -isrc -itest -optP-includedist/build/autogen/cabal_macros.h

2−:set -Wall -fno-warn-name-shadowing

3−

4−:set -XDoAndIfThenElse

5−:set -XOverloadedStrings

6−:set -XBangPatterns

7−:set -XViewPatterns

8−:set -XTypeOperators

9−

10−-- for tests

11−:set -XNamedFieldPuns

12−:set -XRank2Types

13−:set -XRecordWildCards

14−:set -XPatternGuards

15−:set -XScopedTypeVariables

16−:set -fno-warn-unused-do-bind

.github/workflows/haskell-ci.ymlnew file+256

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

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

2+#

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

4+#

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

6+#

7+# haskell-ci regenerate

8+#

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

10+#

11+# version: 0.17.20231110

12+#

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

14+#

15+name: Haskell-CI

16+on:

17+ push:

18+ branches:

19+ - master

20+ pull_request:

21+ branches:

22+ - master

23+jobs:

24+ linux:

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

26+ runs-on: ubuntu-20.04

27+ timeout-minutes:

28+ 60

29+ container:

30+ image: buildpack-deps:bionic

31+ services:

32+ postgres:

33+ image: postgres:14

34+ env:

35+ POSTGRES_PASSWORD: postgres

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

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

38+ strategy:

39+ matrix:

40+ include:

41+ - compiler: ghc-9.8.1

42+ compilerKind: ghc

43+ compilerVersion: 9.8.1

44+ setup-method: ghcup

45+ allow-failure: false

46+ - compiler: ghc-9.6.3

47+ compilerKind: ghc

48+ compilerVersion: 9.6.3

49+ setup-method: ghcup

50+ allow-failure: false

51+ - compiler: ghc-9.4.8

52+ compilerKind: ghc

53+ compilerVersion: 9.4.8

54+ setup-method: ghcup

55+ allow-failure: false

56+ - compiler: ghc-9.2.8

57+ compilerKind: ghc

58+ compilerVersion: 9.2.8

59+ setup-method: ghcup

60+ allow-failure: false

61+ - compiler: ghc-9.0.2

62+ compilerKind: ghc

63+ compilerVersion: 9.0.2

64+ setup-method: ghcup

65+ allow-failure: false

66+ - compiler: ghc-8.10.7

67+ compilerKind: ghc

68+ compilerVersion: 8.10.7

69+ setup-method: ghcup

70+ allow-failure: false

71+ - compiler: ghc-8.8.4

72+ compilerKind: ghc

73+ compilerVersion: 8.8.4

74+ setup-method: hvr-ppa

75+ allow-failure: false

76+ - compiler: ghc-8.6.5

77+ compilerKind: ghc

78+ compilerVersion: 8.6.5

79+ setup-method: hvr-ppa

80+ allow-failure: false

81+ fail-fast: false

82+ steps:

83+ - name: apt

84+ run: |

85+ apt-get update

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

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

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

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

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

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

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

93+ else

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

95+ apt-get update

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

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

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

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

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

101+ fi

102+ env:

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

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

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

106+ - name: Set PATH and environment variables

107+ run: |

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

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

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

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

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

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

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

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

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

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

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

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

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

121+ else

122+ HC=$HCDIR/bin/$HCKIND

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

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

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

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

127+ fi

128+

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

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

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

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

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

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

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

136+ env:

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

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

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

140+ - name: env

141+ run: |

142+ env

143+ - name: write cabal config

144+ run: |

145+ mkdir -p $CABAL_DIR

146+ cat >> $CABAL_CONFIG <<EOF

147+ remote-build-reporting: anonymous

148+ write-ghc-environment-files: never

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

150+ logs-dir: $CABAL_DIR/logs

151+ world-file: $CABAL_DIR/world

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

153+ symlink-bindir: $CABAL_DIR/bin

154+ installdir: $CABAL_DIR/bin

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

156+ store-dir: $CABAL_DIR/store

157+ install-dirs user

158+ prefix: $CABAL_DIR

159+ repository hackage.haskell.org

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

161+ EOF

162+ cat >> $CABAL_CONFIG <<EOF

163+ program-default-options

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

165+ EOF

166+ cat $CABAL_CONFIG

167+ - name: versions

168+ run: |

169+ $HC --version || true

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

171+ $CABAL --version || true

172+ - name: update cabal index

173+ run: |

174+ $CABAL v2-update -v

175+ - name: install cabal-plan

176+ run: |

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

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

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

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

181+ rm -f cabal-plan.xz

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

183+ cabal-plan --version

184+ - name: checkout

185+ uses: actions/checkout@v3

186+ with:

187+ path: source

188+ - name: initial cabal.project for sdist

189+ run: |

190+ touch cabal.project

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

192+ cat cabal.project

193+ - name: sdist

194+ run: |

195+ mkdir -p sdist

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

197+ - name: unpack

198+ run: |

199+ mkdir -p unpacked

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

201+ - name: generate cabal.project

202+ run: |

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

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

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

206+ touch cabal.project

207+ touch cabal.project.local

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

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

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

211+ cat >> cabal.project <<EOF

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

213+ EOF

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

215+ cat cabal.project

216+ cat cabal.project.local

217+ - name: dump install plan

218+ run: |

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

220+ cabal-plan

221+ - name: restore cache

222+ uses: actions/cache/restore@v3

223+ with:

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

225+ path: ~/.cabal/store

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

227+ - name: install dependencies

228+ run: |

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

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

231+ - name: build w/o tests

232+ run: |

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

234+ - name: build

235+ run: |

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

237+ - name: tests

238+ run: |

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

240+ - name: cabal check

241+ run: |

242+ cd ${PKGDIR_postgresql_simple} || false

243+ ${CABAL} -vnormal check

244+ - name: haddock

245+ run: |

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

247+ - name: unconstrained build

248+ run: |

249+ rm -f cabal.project.local

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

251+ - name: save cache

252+ uses: actions/cache/save@v3

253+ if: always()

254+ with:

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

256+ path: ~/.cabal/store

.github/workflows/simple.ymlnew file+58

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

1+name: Simple

2+on:

3+ push:

4+ branches:

5+ - master

6+ pull_request:

7+ branches:

8+ - master

10+jobs:

11+ native:

12+ name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}"

13+ runs-on: ${{ matrix.os }}

14+ strategy:

15+ matrix:

16+ os: [macos-latest, windows-latest]

17+ ghc: ['8.10','9.0','9.2','9.4.8','9.6.3','9.8.1']

18+ fail-fast: false

19+ timeout-minutes:

20+ 60

21+ steps:

22+ - name: Set git to use LF

23+ run: |

24+ git config --global core.autocrlf false

25+ git config --global core.eol lf

26+

27+ - name: Set up Haskell

28+ id: setup-haskell

29+ uses: haskell/actions/setup@v2

30+ with:

31+ ghc-version: ${{ matrix.ghc }}

32+ cabal-version: '3.10.2.0'

33+

34+ - name: Set up PostgreSQL

35+ uses: ikalnytskyi/action-setup-postgres@v3

36+ id: postgres

37+ with:

38+ username: ci

39+ password: sw0rdfish

40+ database: test

41+

42+ - name: Checkout

43+ uses: actions/checkout@v3.0.2

44+

45+ - name: Cache

46+ uses: actions/cache@v2.1.3

47+ with:

48+ path: ${{ steps.setup-haskell.outputs.cabal-store }}

49+ key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}

50+ restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-

51+

52+ - name: Build

53+ run: cabal build all --enable-tests

54+

55+ - name: Test

56+ run: cabal test all --enable-tests --test-show-details=direct

57+ env:

58+ DATABASE_CONNSTRING: ${{ steps.postgres.outputs.connection-uri }}

.gitignore+6

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

7*.o

8\#*\#

9.#*

10+/CHANGELOG.md

10.cabal-sandbox/

11.cabal-sandbox/

12+.stack-work/

11cabal.sandbox.config

13cabal.sandbox.config

14+/dist-newstyle

15+.ghc.environment.*

16+cabal.project.local

17+dump-core

.travis.ymldeleted−11

@@ -1,11 +0,0 @@

1−language: haskell

2−

3−ghc:

4− - 7.6

5− - 7.8

6−

7−addons:

8− postgresql: "9.3"

9−

10−before_install:

11− - createdb `whoami` || true

CHANGES → CHANGES.mdrenamed+336−76

@@ -1,51 +1,311 @@

1−Version 0.5.0.0

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

2− * Removed the deprecated BuiltinTypes module

4− * Modified the SQL quasiquoter so that it returns a Query, not

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

5− an overloaded string, and so that the OverloadedStrings language

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

6− extension is no longer necessary, thanks to Mike Ledger

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

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

12+

13+ * Support `aeson-2.2.0.0`

14+

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

16+

17+ * Add `withConnect`

18+

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

20+

21+ * Add foldCopyData helper function

22+ Thanks to Sebastián Estrella for the implementation

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

24+ * Implement support for postgresql 'interval' type

25+ Thanks to Andre Marques Lee for the implementation

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

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

28+

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

30+

31+ * Add `fromFieldJSONByteString`

32+ Thanks to tomjaguarpaw for the implementation

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

34+ * Add `attoFieldParser`

35+ Thanks to Victor Nawothnig for the implementation

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

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

38+ Thanks to Cary Robbins for the implementation

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

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

41+ for all exception types.

42+ Thanks to Elliot Cameron for the implementation

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

44+ * Fix spurious aborts when retrying transactions

45+ Thanks to Elliot Cameron for the implementation

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

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

48+ with `Aeson` newtype.

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

50+

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

52+

53+ * Define `MonadFail Ok`.

54+

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

56+

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

58+ Thanks to Felix Paulusma for the implementation.

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

60+

61+ * Mention GHC Generics support in the documentation.

62+ Thanks to Gabriel Gonzalez for the implementation.

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

64+

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

66+ Thanks to Max Amanshauser for the implementation.

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

68+

69+ * fromJSONField: Include JSONPath on JSON parse errors

70+ Thanks to Simon Hengel for the implementation.

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

72+

73+ * No TH in implementation

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

75+

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

77+

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

79+

80+ Consider a downstream library depending already both on

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

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

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

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

85+

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

87+

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

89+

90+ ```haskell

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

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

93+ #endif

94+ ```

95+

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

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

98+

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

100+ Thanks to Max Tagher for the implementation.

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

102+

103+ * Add support to CockroachDB.

104+ Thanks to Georte Steel.

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

106+

107+ * Add Generic ConnectInfo instance

108+ Thanks to Dmitry Dzhus.

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

110+

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

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

113+

114+ * Add `fromFieldJSONByteString :: FieldParser ByteString`

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

116+

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

118+ Thanks to Nathan Ferris Hunter.

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

120+

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

122+ Thanks to Bardur Arantsson.

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

124+

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

126+ These are more memory efficient

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

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

129+

130+ * Documentation improvements

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

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

133+

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

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

136+

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

138+ * Refactored some rudimentary cursor handling code out of the

139+ implementation of the fold operators, into a new

140+ `Database.PostgreSQL.Simple.Cursor` module, thanks to Bardur Arantsson.

141+

142+ * Made the `FromField` instance for `Char` compatible with

143+ postgresql's `bpchar` type. Thanks to Ivan Lazar Miljenovic for

144+ reporting the issue.

145+

146+ * Added `Show` and `Eq` instances for `Notification`, thanks to

147+ Matvey Aksenov.

148+

149+ * Fixed some example code, thanks to Matvey Aksenov.

150+

151+ * Fixed a problem with using `conversionError` to throw exceptions

152+ of type `SomeException`. Previously, the exception would be

153+ wrapped in a second `SomeException` dynamic constructor which

154+ would cause normal GHC typecase idioms over `SomeException` to fail.

155+

156+### Version 0.5.2.1 (2016-06-29)

157+ * Bumped the lower bound for `base` to 4.6. Thanks to Herbert

158+ Valerio Riedel for reporting the issue.

159+

160+ * Added an `Eq` instance for `SqlError`, thanks to Chris Allen

161+

162+ * Fixed a bug where a all-caps `"NULL"` text value inside a

163+ postgresql array would get parsed as the SQL null value. Thanks

164+ goes to Edgar Gomes and Silk for finding and fixing this mistake.

165+

166+ * Modified `withTransaction` and friends to ignore `IOError`s when

167+ attempting to roll back the transaction. This fixes a buggy

168+ interaction between `withTransaction` and async exceptions (e.g.

169+ `System.Timeout`) on unix platforms. Thanks goes to Erik

170+ Hesselink and Silk for providing the test case that exposed this

171+ issue.

172+

173+ * Added the `testTimeout` regression test for the problem above.

174+

175+### Version 0.5.2.0 (2016-05-25)

176+ * Significantly improved the error reporting from

177+ `Copy.putCopyData`, thanks to Ben Gamari.

178+

179+ * Moved the test suite to use `tasty`, with a big thanks

180+ to Ben Gamari.

181+

182+ * Added `FromField.optionalField`, and updated the documentation

183+ of `FromField.fromJSONField`, as inspired by an email conversation

184+ with Ian Wagner.

185+

186+ * Updated all links in the haddocks to use https, and added a link

187+ to the documentation of `connectPostgreSQL`.

188+

189+ * Added a truncated changelog to the source distribution.

190+

191+### Version 0.5.1.3 (2016-04-30)

192+ * Implemented the Monad of No Return proposal, future-proofing

193+ postgresql-simple against future releases of GHC.

194+

195+ * Fixed a rare and usually benign race condition where

196+ `getNotification` could end up waiting on a newly reallocated

197+ file descriptor index, potentially leading to deadlock if the

198+ descriptor does not become readable promptly. This fix only

199+ applies to GHC 7.8 or later, as it depends on `threadWaitReadSTM`.

200+

201+ * Tweaked the time parsers to accept times of day of the form `hh:mm`,

202+ omitting seconds, following changes made to aeson.

203+

204+ * Updated the documentation of the `In` type to point out a gotcha

205+ when using the SQL fragment `... NOT IN ?` with `In []`. Thanks

206+ goes to Simon Michael and Dan Haraj for bringing this issue to

207+ my attention.

208+

209+### Version 0.5.1.2 (2015-12-14)

210+ * The syntax generated for empty arrays was changed so that

211+ postgresql's type inference would work better, thanks to

212+ Amit Levy.

213+

214+ * Further revision and expansion of the new Time documentation.

215+

216+### Version 0.5.1.1 (2015-12-02)

217+ * This is a documentation-only release

218+

219+ * The documentation of the `Time` module has been completely

220+ rewritten, and is far longer and more informative. It contains

221+ a brief overview of civil time, the semantics of postgresql's

222+ time types, and their relation to Haskell's time types via

223+ postgresql-simple.

224+

225+ * The documentation of `connectPostgreSQL` has been modified to

226+ mention the effects of environment variables on the connection

227+ string parameters.

228+

229+ * The documentation of `HStore.Internal` has been unhidden from

230+ haddock.

231+

232+ * A typo in example code was fixed courtesy of Levi Notik.

233+

234+### Version 0.5.1.0 (2015-10-22)

235+ * Optimized the implementation of the streaming operators to avoid

236+ creating intermediate lists of rows, thanks to Timo von Holtz.

237+

238+ * Added default instances for `ToRow` and `FromRow` that depend on

239+ Generics, thanks to Alexey Khudyakov.

240+

241+ * Fixed support for bytestring-0.9 and GHC 7.4.

242+

243+### Version 0.5.0.1 (2015-09-21)

244+ * Fixed a bug when printing a `ZonedTime` with a negative offset

245+ that is not a whole number of hours.

246+

247+### Version 0.5.0.0 (2015-09-19)

248+ * Removed the deprecated `BuiltinTypes` module.

249+

250+ * Modified the SQL quasiquoter so that it returns a `Query`, not

251+ an overloaded string, and so that the `OverloadedStrings` language

252+ extension is no longer necessary, thanks to Mike Ledger.

253+

8− * Moved away from blaze-builder in favor of bytestring-builder. This

254+ * Moved away from `blaze-builder` in favor of `bytestring-builder`. This

9 shouldn't affect very many people, but does reduce the transitive

255 shouldn't affect very many people, but does reduce the transitive

10 dependencies.

256 dependencies.

257

258+ * Rewrote the timestamp printers to use the new `Prim`

259+ infrastructure in `bytestring-builder`. The new printers should

260+ be a fair bit faster.

261+

12− * Added support for exclusion violations to the ConstraintViolation

262+ * Added support for exclusion violations to the `ConstraintViolation`

13− type in the Errors module, thanks to Joao Cristovao.

263+ type in the Errors module, thanks to João Cristóvão.

264

15− * Moved away from the uuid package in favor of the uuid-types package,

265+ * Moved away from the `uuid` package in favor of the `uuid-types` package,

16 thanks to Bardur Arantsson. This shouldn't affect anybody, but does

266 thanks to Bardur Arantsson. This shouldn't affect anybody, but does

17 reduce the transitive dependencies.

267 reduce the transitive dependencies.

268

19 * Postgresql-simple now explicitly assumes the UTF8 character encoding

269 * Postgresql-simple now explicitly assumes the UTF8 character encoding

20 for communication between the client and server. All database encodings

270 for communication between the client and server. All database encodings

21− support UTF8 except for Mule Internal Code. An exception should be

271+ support UTF8 except for Mule Internal Code, the Multilingual

272+ Extensions for Emacs. An exception should be raised upon

22− raised upon connecting to a database by the backend if the backend cannot

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

23− accomodate this requirement.

274+ accommodate this requirement.

275

25− * Added Eq and Typeable instance for Connection.

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

277

27− * Added the foldWith, forEachWith, and returningWith families of functions

278+ * Added the `foldWith`, `forEachWith`, and `returningWith` families

28− courtesy of Travis Staton.

279+ of functions courtesy of Travis Staton.

280

30− * Support for Ranged types.

281+ * Support for Ranged types, with thanks to Leonid Onokhov for his

282+ contributions.

283

32− * The FromField instance for JSON now allows for top-level values that

284+ * The `FromField` instance for JSON now allows for top-level values that

33− are not objects or arrays.

285+ are not objects or arrays, thanks to Sam Rijs.

286

35− * The timestamp parsers are now slightly more flexible in what they accept.

287+ * The timestamp parsers have been replaced with those now in Aeson.

36− Thanks goes to Janne Hellsten for his contributions to this issue.

288+ Janne Hellsten adapted the old parsers from postgresql-simple for

289+ inclusion in Aeson; Bryan O'Sullivan rewrote those parsers to be

290+ faster, with some tweaks contributed by myself. And now to

291+ bring the effort full circle, the result has been brought back to

292+ postgresql-simple, with some adaptations.

293

38− * Optimized the parsing of timestamps with fractional seconds, shaving

294+ * Fixed a bug in the typeinfo system where postgresql's `_record` type

39− approximately 17% off the time taken.

295+ was being reported as a basic type and not an array type. Thanks to

296+ Nickolay Kolev for helping to expose this issue.

297

298+ * Fixed a bug with the `typeInfo` operator, thanks to Timmy Tofu. In the

299+ case of parsing subfields of arrays and composites, it would fetch the

300+ `TypeInfo` of the array or composite type and not the subtype.

301

42−Version 0.4.10.0 (2015-02-26)

302+### Version 0.4.10.0 (2015-02-26)

43 * Added a blurb about SSL/TLS in the documentation for connectPostgreSQL

303 * Added a blurb about SSL/TLS in the documentation for connectPostgreSQL

304

45 * Moved some functions into the Internal module, courtesy of Aleksey

305 * Moved some functions into the Internal module, courtesy of Aleksey

46 Uimanov.

306 Uimanov.

307

48−Version 0.4.9.0 (2014-12-27)

308+### Version 0.4.9.0 (2014-12-27)

49 * Made the fromField method for PGArray available as pgArrayFieldParser,

309 * Made the fromField method for PGArray available as pgArrayFieldParser,

50 outside of the typeclass courtesy of Tom Ellis.

310 outside of the typeclass courtesy of Tom Ellis.

311

@@ -53,13 +313,13 @@ Version 0.4.9.0 (2014-12-27)

313

54 * Fixed deprecation warnings, courtesy of Simon Hengel.

314 * Fixed deprecation warnings, courtesy of Simon Hengel.

315

56−Version 0.4.8.0 (2014-11-24)

316+### Version 0.4.8.0 (2014-11-24)

57 * Added support for postgresql's citext type extension via the

317 * Added support for postgresql's citext type extension via the

58 case-insensitive package.

318 case-insensitive package.

319

60 * Added the function parseHStoreList to the HStore module.

320 * Added the function parseHStoreList to the HStore module.

321

62−Version 0.4.7.0 (2014-10-27)

322+### Version 0.4.7.0 (2014-10-27)

63 * Added support for very old timestamps to UTCTime. Depending on time

323 * Added support for very old timestamps to UTCTime. Depending on time

64 zone, very old timestamps can be returned with a offset from UTC that

324 zone, very old timestamps can be returned with a offset from UTC that

65 contains seconds.

325 contains seconds.

@@ -79,24 +339,24 @@ Version 0.4.7.0 (2014-10-27)

339

80 Thanks to Michael Snoyman for his assistance with this issue.

340 Thanks to Michael Snoyman for his assistance with this issue.

341

82−Version 0.4.6.0 (2014-10-07)

342+### Version 0.4.6.0 (2014-10-07)

83 * Added an instance ToField NominalDiffTime.

343 * Added an instance ToField NominalDiffTime.

344

85−Version 0.4.5.0 (2014-09-26)

345+### Version 0.4.5.0 (2014-09-26)

86 * Added support for retrieving NaN and ±Infinity floating point values

346 * Added support for retrieving NaN and ±Infinity floating point values

87 from postgres to the FromField instances for Float, Double, and Rational.

347 from postgres to the FromField instances for Float, Double, and Rational.

88 The instance for Scientific is unchanged due to the fact it has no

348 The instance for Scientific is unchanged due to the fact it has no

89 way of representing these special values. Thanks goes to Tom Nielsen

349 way of representing these special values. Thanks goes to Tom Nielsen

90 for reporting the issue.

350 for reporting the issue.

351

92−Version 0.4.4.1 (2014-09-07)

352+### Version 0.4.4.1 (2014-09-07)

93 * Fixed a rather serious bug that prevented the COPY module from working

353 * Fixed a rather serious bug that prevented the COPY module from working

94 at all on unix clients since version 0.4.3.0. Thanks goes to

354 at all on unix clients since version 0.4.3.0. Thanks goes to

95 Dmitry Dzhus for reporting the issue.

355 Dmitry Dzhus for reporting the issue.

356

97 * Added a regression test for the COPY module to the test suite.

357 * Added a regression test for the COPY module to the test suite.

358

99−Version 0.4.4.0 (2014-08-26)

359+### Version 0.4.4.0 (2014-08-26)

100 * Added the jsonb type debuting in PostgreSQL 9.4 to the TypeInfo.Static

360 * Added the jsonb type debuting in PostgreSQL 9.4 to the TypeInfo.Static

101 and Builtin tables, and extended the out-of-box json instances to

361 and Builtin tables, and extended the out-of-box json instances to

102 be compatible with the new type. Thanks to Tobias Florek for the

362 be compatible with the new type. Thanks to Tobias Florek for the

@@ -105,7 +365,7 @@ Version 0.4.4.0 (2014-08-26)

105 * Ported some expanded documentation from mysql-simple, and fixed

365 * Ported some expanded documentation from mysql-simple, and fixed

106 a documentation typo.

366 a documentation typo.

107

367

108−Version 0.4.3.0 (2014-07-10)

368+### Version 0.4.3.0 (2014-07-10)

109 * connect and exec now use libpq asynchronously on non-Windows platforms.

369 * connect and exec now use libpq asynchronously on non-Windows platforms.

110 This means we are using threadWaitRead and threadWaitWrite to

370 This means we are using threadWaitRead and threadWaitWrite to

111 have GHC's IO manager schedule non-blocking C calls to libpq,

371 have GHC's IO manager schedule non-blocking C calls to libpq,

@@ -119,7 +379,7 @@ Version 0.4.3.0 (2014-07-10)

119 that originate from client-side code. However, this goal

379 that originate from client-side code. However, this goal

120 isn't perfectly achieved as of yet.

380 isn't perfectly achieved as of yet.

121

381

122−Version 0.4.2.3 (2014-06-04)

382+### Version 0.4.2.3 (2014-06-04)

123 * This is strictly a documentation release, with no code changes.

383 * This is strictly a documentation release, with no code changes.

124

384

125 * Fixed several documentation typos, thanks to Chris Allen and remdezx.

385 * Fixed several documentation typos, thanks to Chris Allen and remdezx.

@@ -130,13 +390,13 @@ Version 0.4.2.3 (2014-06-04)

130

390

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

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

132

392

133−Version 0.4.2.2 (2014-05-15)

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

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

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

135

395

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

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

137 foldWithOptions, executeMany, and returning operators.

397 foldWithOptions, executeMany, and returning operators.

138

398

139−Version 0.4.2.1 (2014-03-27)

399+### Version 0.4.2.1 (2014-03-27)

140 * Fixed bug in Values syntax generation

400 * Fixed bug in Values syntax generation

141

401

142 * Improved documentation, including examples of multi-row update,

402 * Improved documentation, including examples of multi-row update,

@@ -144,17 +404,17 @@ Version 0.4.2.1 (2014-03-27)

144 floating point numbers from the database, and the IsString instance

404 floating point numbers from the database, and the IsString instance

145 for QualifiedIdentifier.

405 for QualifiedIdentifier.

146

406

147−Version 0.4.2.0 (2014-03-22)

407+### Version 0.4.2.0 (2014-03-22)

148 * Added ToField and FromField instances for the scientific package

408 * Added ToField and FromField instances for the scientific package

149

409

150 * Changed the Identifier and QualifiedIdentifier to use Text in

410 * Changed the Identifier and QualifiedIdentifier to use Text in

151 order to avoid encoding errors. Technically this requires a

411 order to avoid encoding errors. Technically this requires a

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

153

413

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

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

155 and tweaked error messages.

415 and tweaked error messages.

156

416

157−Version 0.4.1.0 (2014-03-22)

417+### Version 0.4.1.0 (2014-03-22)

158 * Fixed the parsing of arrays containing null values, courtesy of

418 * Fixed the parsing of arrays containing null values, courtesy of

159 Francesco Mazzoli

419 Francesco Mazzoli

160

420

@@ -166,17 +426,17 @@ Version 0.4.1.0 (2014-03-22)

166 more general than executeMany and returning. See the

426 more general than executeMany and returning. See the

167 Database.PostgreSQL.Simple.Types.Values data type.

427 Database.PostgreSQL.Simple.Types.Values data type.

168

428

169−Version 0.4.0.2 (2014-01-12)

429+### Version 0.4.0.2 (2014-01-12)

170 * Tweaked C preprocessor directive to be more portable

430 * Tweaked C preprocessor directive to be more portable

171

431

172 * Tweaked testsuite for compatibility with aeson-0.7

432 * Tweaked testsuite for compatibility with aeson-0.7

173

433

174−Version 0.4.0.1 (2013-12-21)

434+### Version 0.4.0.1 (2013-12-21)

175 * Relaxed dependency on aeson to >= 0.6

435 * Relaxed dependency on aeson to >= 0.6

176

436

177 * Update the documentation of `fromField`

437 * Update the documentation of `fromField`

178

438

179−Version 0.4.0.0 (2013-12-21)

439+### Version 0.4.0.0 (2013-12-21)

180 * Changed the calling code of `fromField` so that it always sends

440 * Changed the calling code of `fromField` so that it always sends

181 a copy of the raw data. This should be a small but significant

441 a copy of the raw data. This should be a small but significant

182 performance bump for most people most of the time; however it

442 performance bump for most people most of the time; however it

@@ -192,15 +452,15 @@ Version 0.4.0.0 (2013-12-21)

192

452

193 * Added FromField instances for IORef, MVar, and IOVector.

453 * Added FromField instances for IORef, MVar, and IOVector.

194

454

195−Version 0.3.10.0 (2013-12-17)

455+### Version 0.3.10.0 (2013-12-17)

196 * Added the queryWith function, courtesy of Leonid Onokhov

456 * Added the queryWith function, courtesy of Leonid Onokhov

197

457

198 * Added the Default type, for representing postgresql's default values

458 * Added the Default type, for representing postgresql's default values

199

459

200−Version 0.3.9.1 (2013-10-28)

460+### Version 0.3.9.1 (2013-10-28)

201 * Removed dependency on hashable

461 * Removed dependency on hashable

202

462

203−Version 0.3.9.0 (2013-10-27)

463+### Version 0.3.9.0 (2013-10-27)

204 * Added FromField and ToField instances for the `uuid` package,

464 * Added FromField and ToField instances for the `uuid` package,

205 courtesy of Bas van Dijk.

465 courtesy of Bas van Dijk.

206

466

@@ -210,16 +470,16 @@ Version 0.3.9.0 (2013-10-27)

210 * Added the fromBinary, fromHStoreMap, and fromHStoreList newtype

470 * Added the fromBinary, fromHStoreMap, and fromHStoreList newtype

211 unwrapper functions, courtesy of Bas van Dijk.

471 unwrapper functions, courtesy of Bas van Dijk.

212

472

213−Version 0.3.8.0 (2013-10-11)

473+### Version 0.3.8.0 (2013-10-11)

214 * Fixed the example code in `FromField`, thanks to Adam Bergmark.

474 * Fixed the example code in `FromField`, thanks to Adam Bergmark.

215

475

216 * Added `Notification.getBackendPID`.

476 * Added `Notification.getBackendPID`.

217

477

218−Version 0.3.7.1 (2013-09-12)

478+### Version 0.3.7.1 (2013-09-12)

219 * Relaxed the dependency on bytestring-0.10 back to bytestring-0.9,

479 * Relaxed the dependency on bytestring-0.10 back to bytestring-0.9,

220 courtesy of Michael Snoyman

480 courtesy of Michael Snoyman

221

481

222−Version 0.3.7.0 (2013-09-11)

482+### Version 0.3.7.0 (2013-09-11)

223 * Added `aeson` as a dependency.

483 * Added `aeson` as a dependency.

224

484

225 * Added ToField and FromField instances for aeson's JSON.Value type,

485 * Added ToField and FromField instances for aeson's JSON.Value type,

@@ -240,7 +500,7 @@ Version 0.3.7.0 (2013-09-11)

240

500

241 * Various documentation fixes.

501 * Various documentation fixes.

242

502

243−Version 0.3.6.0 (2013-08-19)

503+### Version 0.3.6.0 (2013-08-19)

244 * Added the json type to BuiltinTypes and TypeInfo.Static, courtesy of

504 * Added the json type to BuiltinTypes and TypeInfo.Static, courtesy of

245 Manuel Gómez.

505 Manuel Gómez.

246

506

@@ -251,14 +511,14 @@ Version 0.3.6.0 (2013-08-19)

251 months from now. Fixed the example code in FromField to reflect

511 months from now. Fixed the example code in FromField to reflect

252 this change.

512 this change.

253

513

254−Version 0.3.5.0 (2013-08-09)

514+### Version 0.3.5.0 (2013-08-09)

255 * Added an FromRow instance for Vector, semantically identical to the

515 * Added an FromRow instance for Vector, semantically identical to the

256 existing FromRow instance for [], courtesy of Doug Beardsley

516 existing FromRow instance for [], courtesy of Doug Beardsley

257

517

258 * Reworked the documentation for the Copy module, and tweaked the

518 * Reworked the documentation for the Copy module, and tweaked the

259 documentation for the LargeObjects module.

519 documentation for the LargeObjects module.

260

520

261−Version 0.3.4.0 (2013-07-23)

521+### Version 0.3.4.0 (2013-07-23)

262 * Added direct support for COPY IN and COPY OUT, without having

522 * Added direct support for COPY IN and COPY OUT, without having

263 to use raw postgresql-libpq calls and postgresql-simple's Internal

523 to use raw postgresql-libpq calls and postgresql-simple's Internal

264 module.

524 module.

@@ -267,49 +527,49 @@ Version 0.3.4.0 (2013-07-23)

267 exception instead of an ErrorCall exception when it fails to fetch

527 exception instead of an ErrorCall exception when it fails to fetch

268 the connection's file descriptor from libpq.

528 the connection's file descriptor from libpq.

269

529

270−Version 0.3.3.2 (2013-06-18)

530+### Version 0.3.3.2 (2013-06-18)

271 * Optimized the definition of `mconcat` in the Monoid instance for

531 * Optimized the definition of `mconcat` in the Monoid instance for

272 the Query type, courtesy of Joey Adams.

532 the Query type, courtesy of Joey Adams.

273

533

274−Version 0.3.3.1 (2013-06-06)

534+### Version 0.3.3.1 (2013-06-06)

275 * `getNotification` now works on Windows, albeit using a one-second

535 * `getNotification` now works on Windows, albeit using a one-second

276 polling loop, courtesy of Joey Adams.

536 polling loop, courtesy of Joey Adams.

277

537

278−Version 0.3.3.0 (2013-05-29)

538+### Version 0.3.3.0 (2013-05-29)

279 * Fixed two issues with the fold operator: fold would raise the wrong

539 * Fixed two issues with the fold operator: fold would raise the wrong

280 exception, and gave the database cursor a static name preventing

540 exception, and gave the database cursor a static name preventing

281 folds from being nested. Thanks to Joey Adams for his

541 folds from being nested. Thanks to Joey Adams for his

282 work on these issues.

542 work on these issues.

283

543

284−Version 0.3.2.0 (2013-05-20)

544+### Version 0.3.2.0 (2013-05-20)

285 * Added a savepoint abstraction to the Transaction module, courtesy

545 * Added a savepoint abstraction to the Transaction module, courtesy

286 of Joey Adams

546 of Joey Adams

287

547

288−Version 0.3.1.2 (2013-04-29)

548+### Version 0.3.1.2 (2013-04-29)

289 * Fixed hstore parser to not unnecessarily reverse the key-value pairs

549 * Fixed hstore parser to not unnecessarily reverse the key-value pairs

290

550

291−Version 0.3.1.1 (2013-04-29)

551+### Version 0.3.1.1 (2013-04-29)

292 * Fixed hstore parser to recognize empty hstores, courtesy of Simon

552 * Fixed hstore parser to recognize empty hstores, courtesy of Simon

293 Meier

553 Meier

294

554

295−Version 0.3.1.0 (2013-04-26)

555+### Version 0.3.1.0 (2013-04-26)

296 * Added support for Range and Composite types to the TypeInfo system.

556 * Added support for Range and Composite types to the TypeInfo system.

297

557

298 * Added support for hstore types in the Simple.HStore module.

558 * Added support for hstore types in the Simple.HStore module.

299

559

300 * Improved documentation of the FromField module.

560 * Improved documentation of the FromField module.

301

561

302−Version 0.3.0.1 (2013-03-26)

562+### Version 0.3.0.1 (2013-03-26)

303 * A large chunk of the documentation inside the FromField module had

563 * A large chunk of the documentation inside the FromField module had

304 silently failed to render in Haddock.

564 silently failed to render in Haddock.

305

565

306−Version 0.3.0.0 (2013-03-25)

566+### Version 0.3.0.0 (2013-03-25)

307 * Added support for PostgreSQL's Array Types. Thanks to Jason Dusek

567 * Added support for PostgreSQL's Array Types. Thanks to Jason Dusek

308 for his work on this feature.

568 for his work on this feature.

309

569

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

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

311 convenient and efficient access to the pg_type metatable. This

571 convenient and efficient access to the pg_type metatable. This

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

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

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

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

314 work on this feature.

574 work on this feature.

315

575

@@ -345,33 +605,33 @@ Version 0.3.0.0 (2013-03-25)

345 now stripped out.

605 now stripped out.

346

606

347

607

348−Version 0.2.4.1 (2012-08-29)

608+### Version 0.2.4.1 (2012-08-29)

349 * Fixed the documentation of `In`. Thanks to rekado and dstcruz for

609 * Fixed the documentation of `In`. Thanks to rekado and dstcruz for

350 pointing this out.

610 pointing this out.

351

611

352−Version 0.2.4.0 (2012-08-23)

612+### Version 0.2.4.0 (2012-08-23)

353 * Added the `withTransactionSerializable` and `withTransactionModeRetry`

613 * Added the `withTransactionSerializable` and `withTransactionModeRetry`

354 operators, thanks to Joey Adams.

614 operators, thanks to Joey Adams.

355

615

356−Version 0.2.3.0 (2012-08-09)

616+### Version 0.2.3.0 (2012-08-09)

357 * Added the `returning` operator, thanks to Jason Dusek

617 * Added the `returning` operator, thanks to Jason Dusek

358

618

359−Version 0.2.2.0 (2012-07-26)

619+### Version 0.2.2.0 (2012-07-26)

360 * Added a ToRow instance for the (:.) type, courtesy of Leonid Onokhov

620 * Added a ToRow instance for the (:.) type, courtesy of Leonid Onokhov

361

621

362 * Added the type oid for PostgreSQL's `uuid` type to BuiltinTypes

622 * Added the type oid for PostgreSQL's `uuid` type to BuiltinTypes

363

623

364−Version 0.2.1.0 (2012-07-23)

624+### Version 0.2.1.0 (2012-07-23)

365 * Added the FromRow.fieldWith operator, thanks to Leonid Onokhov

625 * Added the FromRow.fieldWith operator, thanks to Leonid Onokhov

366

626

367 * Added a type synonym for FieldParser

627 * Added a type synonym for FieldParser

368

628

369−Version 0.2.0.1 (2012-06-21)

629+### Version 0.2.0.1 (2012-06-21)

370 * Fixed a compatibility problem with PostgreSQL 8.1, which does not allow

630 * Fixed a compatibility problem with PostgreSQL 8.1, which does not allow

371 clients to set their own value for `standard_conforming_strings`. This

631 clients to set their own value for `standard_conforming_strings`. This

372 connection variable is still set to `on` for PostgreSQL 8.2 and later.

632 connection variable is still set to `on` for PostgreSQL 8.2 and later.

373

633

374−Version 0.2: (2012-06-19)

634+### Version 0.2: (2012-06-19)

375 * Removed the conversion from `timestamp` to `UTCTime`. Some code will be

635 * Removed the conversion from `timestamp` to `UTCTime`. Some code will be

376 broken even though it will still compile.

636 broken even though it will still compile.

377

637

@@ -380,16 +640,16 @@ Version 0.2: (2012-06-19)

380 * Exported ToRow/FromRow from Database.PostgreSQL.Simple

640 * Exported ToRow/FromRow from Database.PostgreSQL.Simple

381

641

382

642

383−Version 0.1.4.3: (2012-06-10)

643+### Version 0.1.4.3: (2012-06-10)

384 * Fix language extensions for compatibility with GHC 7.0

644 * Fix language extensions for compatibility with GHC 7.0

385

645

386−Version 0.1.4.2: (2012-06-10)

646+### Version 0.1.4.2: (2012-06-10)

387 * Fix a wayward dependency on Text.

647 * Fix a wayward dependency on Text.

388

648

389−Version 0.1.4.1: (2012-06-10)

649+### Version 0.1.4.1: (2012-06-10)

390 * Added support for timezones with minutes in their UTC offset.

650 * Added support for timezones with minutes in their UTC offset.

391

651

392−Version 0.1.4: (2012-06-10)

652+### Version 0.1.4: (2012-06-10)

393 * Removed pcre-light dependency, courtesy of Joey Adams.

653 * Removed pcre-light dependency, courtesy of Joey Adams.

394

654

395 * Reworked support for the Time types.

655 * Reworked support for the Time types.

@@ -401,7 +661,7 @@ Version 0.1.4: (2012-06-10)

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

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

402

662

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

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

404− that accomodate PostgreSQL's infinities.

664+ that accommodate PostgreSQL's infinities.

405

665

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

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

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

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

@@ -414,13 +674,13 @@ Version 0.1.4: (2012-06-10)

414 * Renaming some of the type names in `BuiltinTypes`.

674 * Renaming some of the type names in `BuiltinTypes`.

415

675

416

676

417−Version 0.1.3: (2012-05-30)

677+### Version 0.1.3: (2012-05-30)

418 * Made ZonedTime an instance of FromField and ToField

678 * Made ZonedTime an instance of FromField and ToField

419

679

420 * Added getNotificationNonBlocking

680 * Added getNotificationNonBlocking

421

681

422

682

423−Version 0.1.2: (2012-05-09)

683+### Version 0.1.2: (2012-05-09)

424 * Switched to libpq-based escaping for bytea types; Binary now works with

684 * Switched to libpq-based escaping for bytea types; Binary now works with

425 PostgreSQL 8 courtesy of Joey Adams.

685 PostgreSQL 8 courtesy of Joey Adams.

426

686

@@ -433,7 +693,7 @@ Version 0.1.2: (2012-05-09)

433 * Exported (:.) from Database.PostgreSQL.Simple

693 * Exported (:.) from Database.PostgreSQL.Simple

434

694

435

695

436−Version 0.1.1: (2012-05-06)

696+### Version 0.1.1: (2012-05-06)

437 * Added some preliminary documentation for the Ok, Notification, and

697 * Added some preliminary documentation for the Ok, Notification, and

438 LargeObjects modules

698 LargeObjects modules

439

699

@@ -442,7 +702,7 @@ Version 0.1.1: (2012-05-06)

442 * Fixed a bug relating to handling the transaction level

702 * Fixed a bug relating to handling the transaction level

443

703

444

704

445−Version 0.1: (2012-05-04)

705+### Version 0.1: (2012-05-04)

446 * Renamed several modules, typeclasses, and functions:

706 * Renamed several modules, typeclasses, and functions:

447

707

448 QueryParams (renderParams) -> ToRow (toRow)

708 QueryParams (renderParams) -> ToRow (toRow)

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.

CONTRIBUTORS+8

@@ -26,3 +26,11 @@ Bardur Arantsson <bardur@scientician.net>

26Travis Staton <hello@travisstaton.com>

27Sam Rijs <srijs@airpost.net>

28Janne Hellsten <jjhellst@gmail.com>

29+Timmy Tofu <timmytofu@users.noreply.github.com>

30+Alexey Khudyakov <alexey.skladnoy@gmail.com>

31+Timo von Holtz <tvh@anchor.com.au>

32+Amit Levy <amit@amitlevy.com>

33+Ben Gamari <ben@smart-cactus.org>

34+Edgar Gomes Araujo <talktoedgar@gmail.com>

35+Erik Hesselink <hesselink@gmail.com>

36+Matvey Aksenov <matvey.aksenov@gmail.com>

README.md−3

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

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

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

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

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

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

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

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

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

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

bench/Select.hsnew file+32

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

1+{-# LANGUAGE OverloadedStrings #-}

2+module Main where

4+import Database.PostgreSQL.Simple

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

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

8+import System.Environment (getArgs)

9+import Data.Foldable (Foldable, foldl')

10+import qualified Data.Vector.Unboxed as VU

11+

12+main :: IO ()

13+main = do

14+ args <- getArgs

15+ conn <- connectPostgreSQL ""

16+ case args of

17+ ("vector":_) -> do

18+ result <- V.query_ conn "SELECT * FROM generate_series(1, 10000000);"

19+ print (process result)

20+ ("unboxed":_) -> do

21+ -- dummy column

22+ result <- VU.query_ conn "SELECT (NULL :: VOID), * FROM generate_series(1, 10000000);"

23+ print (process' result)

24+ _ -> do

25+ result <- query_ conn "SELECT * FROM generate_series(1, 10000000);"

26+ print (process result)

27+

28+process :: Foldable f => f (Only Int) -> Int

29+process = foldl' (\x (Only y) -> max x y) 0

30+

31+process' :: VU.Vector ((), Int) -> Int

32+process' = VU.foldl' (\x (_, y) -> max x y) 0

cabal.haskell-cinew file+5

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

1+branches: master

2+postgresql: True

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

5+-- osx: 8.4.4

cabal.projectnew file+4

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

1+packages: .

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+153−95

@@ -1,117 +1,175 @@

1+cabal-version: 1.12

1−Name: postgresql-simple

2+name: postgresql-simple

2−Version: 0.5.0.0

3+version: 0.7.0.0

4+x-revision: 1

3−Synopsis: Mid-Level PostgreSQL client library

5+synopsis: Mid-Level PostgreSQL client library

4−Description:

6+description:

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

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

6−License: BSD3

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

15−Cabal-version: >= 1.9.2

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:

18+category: Database

19+build-type: Simple

17extra-source-files:

20extra-source-files:

21+ CHANGES.md

18− CONTRIBUTORS

22+ CONTRIBUTORS

23+ test/results/malformed-input.expected

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

20−Library

26+tested-with:

21− hs-source-dirs: src

27+ GHC ==8.6.5

22− Exposed-modules:

28+ || ==8.8.4

23− Database.PostgreSQL.Simple

29+ || ==8.10.7

24− Database.PostgreSQL.Simple.Arrays

30+ || ==9.0.2

25− Database.PostgreSQL.Simple.Copy

31+ || ==9.2.8

26− Database.PostgreSQL.Simple.FromField

32+ || ==9.4.8

27− Database.PostgreSQL.Simple.FromRow

33+ || ==9.6.3

28− Database.PostgreSQL.Simple.LargeObjects

34+ || ==9.8.1

29− Database.PostgreSQL.Simple.HStore

30− Database.PostgreSQL.Simple.HStore.Internal

31− Database.PostgreSQL.Simple.Notification

32− Database.PostgreSQL.Simple.Ok

33− Database.PostgreSQL.Simple.Range

34− Database.PostgreSQL.Simple.SqlQQ

35− Database.PostgreSQL.Simple.Time

36− Database.PostgreSQL.Simple.Time.Internal

37− Database.PostgreSQL.Simple.ToField

38− Database.PostgreSQL.Simple.ToRow

39− Database.PostgreSQL.Simple.Transaction

40− Database.PostgreSQL.Simple.TypeInfo

41− Database.PostgreSQL.Simple.TypeInfo.Macro

42− Database.PostgreSQL.Simple.TypeInfo.Static

43− Database.PostgreSQL.Simple.Types

44− Database.PostgreSQL.Simple.Errors

45−-- Other-modules:

46− Database.PostgreSQL.Simple.Internal

36+library

37+ default-language: Haskell2010

38+ hs-source-dirs: src

48− Other-modules:

39+ exposed-modules:

40+ Database.PostgreSQL.Simple

41+ Database.PostgreSQL.Simple.Arrays

42+ Database.PostgreSQL.Simple.Copy

49− Database.PostgreSQL.Simple.Compat

43+ Database.PostgreSQL.Simple.Cursor

50− Database.PostgreSQL.Simple.HStore.Implementation

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

51− Database.PostgreSQL.Simple.Time.Implementation

56+ Database.PostgreSQL.Simple.Time

52− Database.PostgreSQL.Simple.Time.Parser

57+ Database.PostgreSQL.Simple.Time.Internal

53− Database.PostgreSQL.Simple.TypeInfo.Types

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

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

55− Build-depends:

79+ build-depends:

80+ base >=4.12.0.0 && <4.20

81+ , bytestring >=0.10.8.2 && <0.13

82+ , containers >=0.6.0.1 && <0.7

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

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

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

86+ , transformers >=0.5.6.2 && <0.7

87+

88+ -- Other dependencies

89+ build-depends:

56− aeson >= 0.6,

90+ aeson >=2.1.2.1 && <2.3

57− attoparsec >= 0.10.3,

91+ , attoparsec >=0.14.4 && <0.15

58− base < 5,

59− bytestring >= 0.9,

60− bytestring-builder,

61− case-insensitive,

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

62− containers,

63− hashable,

93+ , hashable >=1.4.3.0 && <1.5

94+ , Only >=0.1 && <0.1.1

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

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

65− template-haskell,

96+ , scientific >=0.3.7.0 && <0.4

66− text >= 0.11.1,

67− time,

68− transformers,

69− uuid-types >= 1.0.0,

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

70− scientific,

71− vector

98+ , vector >=0.13.0.0 && <0.14

100+ default-extensions:

101+ BangPatterns

102+ DoAndIfThenElse

73− extensions: DoAndIfThenElse, OverloadedStrings, BangPatterns, ViewPatterns

103+ OverloadedStrings

74− TypeOperators

104+ TypeOperators

105+ ViewPatterns

106

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

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

108

78source-repository head

109source-repository head

79 type: git

110 type: git

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

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

112

82−source-repository this

113+test-suite inspection

83− type: git

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

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

122+ , postgresql-simple

85− tag: v0.5.0.0

123+ , tasty

124+ , tasty-hunit

125

87test-suite test

126test-suite test

127+ default-language: Haskell2010

88− type: exitcode-stdio-1.0

128+ type: exitcode-stdio-1.0

89−

90− hs-source-dirs: test

129+ hs-source-dirs: test

91− main-is: Main.hs

130+ main-is: Main.hs

92 other-modules:

131 other-modules:

93 Common

132 Common

133+ Exception

134+ Interval

94 Notify

135 Notify

95 Serializable

136 Serializable

96 Time

137 Time

138

139+ ghc-options: -threaded

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

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

141+ default-extensions:

142+ NamedFieldPuns

143+ OverloadedStrings

144+ PatternGuards

145+ Rank2Types

146+ RecordWildCards

147+ ScopedTypeVariables

148

100− extensions: NamedFieldPuns

149+ build-depends:

101− , OverloadedStrings

150+ aeson

102− , Rank2Types

151+ , base

103− , RecordWildCards

152+ , base16-bytestring

104− , PatternGuards

153+ , bytestring

105− , ScopedTypeVariables

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

106

166

167+benchmark select

168+ default-language: Haskell2010

169+ type: exitcode-stdio-1.0

170+ hs-source-dirs: bench

171+ main-is: Select.hs

107− build-depends: base

172+ build-depends:

108− , aeson

173+ base

109− , base16-bytestring

110− , bytestring

111− , containers

112− , cryptohash

113− , HUnit

114− , postgresql-simple

174+ , postgresql-simple

115− , text

116− , time

117− , vector

175+ , vector

sdist.shnew file+25

@@ -0,0 +1,25 @@

1+#!/bin/bash

3+echo "Generating CHANGELOG.md"

4+echo

6+cat <<HEADER > CHANGELOG.md

7+For the full changelog, see

8+<https://github.com/lpsmith/postgresql-simple/blob/master/CHANGES.md>

10+HEADER

11+

12+perl -ne '$n++ if /^###/; exit if $n==2; print' CHANGES.md >> CHANGELOG.md

13+

14+cat CHANGELOG.md

15+rm -f ./dist/*.tar

16+rm -f ./dist/*.tar.gz

17+cabal sdist

18+cd dist

19+wc *.tar.gz

20+gunzip *.gz

21+wc *.tar

22+zopfli *.tar

23+wc *.tar.gz

24+cd ..

25+rm -f ./dist/*.tar

src/Database/PostgreSQL/Simple.hs+38−98

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

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67+ , SomePostgreSqlException(..)

67 , SqlError(..)

68 , SqlError(..)

68 , PQ.ExecStatus(..)

69 , PQ.ExecStatus(..)

69 , FormatError(..)

70 , FormatError(..)

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

73 , Base.connectPostgreSQL

74 , Base.connectPostgreSQL

74 , Base.close

75 , Base.close

75 , Base.connect

76 , Base.connect

77+ , Base.withConnect

76 , Base.ConnectInfo(..)

78 , Base.ConnectInfo(..)

77 , Base.defaultConnectInfo

79 , Base.defaultConnectInfo

78 , Base.postgreSQLConnectionString

80 , Base.postgreSQLConnectionString

@@ -118,30 +120,26 @@ module Database.PostgreSQL.Simple

118 , formatQuery

120 , formatQuery

119 ) where

121 ) where

120

122

121−import Data.ByteString.Builder

123+import Data.ByteString.Builder (Builder, byteString, char8)

122− ( Builder, byteString, char8, intDec )

123import Control.Applicative ((<$>))

124import Control.Applicative ((<$>))

124import Control.Exception as E

125import Control.Exception as E

125−import Control.Monad (foldM)

126import Data.ByteString (ByteString)

127import Data.Int (Int64)

128import Data.List (intersperse)

129import Data.Monoid (mconcat)

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

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

131+import Database.PostgreSQL.Simple.Cursor

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

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

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

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

133−import Database.PostgreSQL.Simple.Ok

134import Database.PostgreSQL.Simple.ToField (Action(..))

135import Database.PostgreSQL.Simple.ToRow (ToRow(..))

136import Database.PostgreSQL.Simple.Types

137 ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )

138import Database.PostgreSQL.Simple.Internal as Base

139+import Database.PostgreSQL.Simple.Internal.PQResultUtils

139import Database.PostgreSQL.Simple.Transaction

140import Database.PostgreSQL.Simple.Transaction

140−import Database.PostgreSQL.Simple.TypeInfo

141import qualified Database.PostgreSQL.LibPQ as PQ

142import qualified Data.ByteString.Char8 as B

143−import Control.Monad.Trans.Reader

144−import Control.Monad.Trans.State.Strict

145

143

146

144

147-- | Format a query string.

145-- | Format a query string.

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

280 skipSpace = B.dropWhile isSpace_ascii

278 skipSpace = B.dropWhile isSpace_ascii

281

279

282

280

283−

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

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

285buildQuery conn q template xs =

282buildQuery conn q template xs =

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

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

287 where split s =

284 where split s =

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

289 in byteString h

288 in byteString h

290 : if B.null t

289 : if B.null t

291 then []

290 then []

292 else split (B.tail t)

291 else split (B.tail t)

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

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

294 zipParams [t] [] = t

293 zipParams [t] [] = t

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

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

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

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

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

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

297+ countSingleQs = go 0 template

298+ where go i "" = (i :: Int)

299+ go i bs = case qms of

300+ ("?","?") -> go i nextQMBS

301+ ("?",_) -> go (i+1) nextQMBS

302+ _ -> i

303+ where qms = B.splitAt 1 qmBS

304+ (qmBS,nextQMBS) = B.splitAt 2 qmBS'

305+ qmBS' = B.dropWhile (/= '?') bs

298

306

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

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

300-- expected to return results.

308-- expected to return results.

@@ -332,10 +340,10 @@ execute conn template qs = do

332-- @

340-- @

333-- executeMany c [sql|

341-- executeMany c [sql|

334-- UPDATE sometable

342-- UPDATE sometable

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

343+-- SET y = upd.y

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

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

337-- WHERE sometable.x = upd.x

345-- WHERE sometable.x = upd.x

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

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

339-- @

347-- @

340

348

341executeMany :: (ToRow q) => Connection -> Query -> [q] -> IO Int64

349executeMany :: (ToRow q) => Connection -> Query -> [q] -> IO Int64

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

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

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

360returning = returningWith fromRow

368returning = returningWith fromRow

361

369

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

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

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

363returningWith _ _ _ [] = return []

372returningWith _ _ _ [] = return []

364returningWith parser conn q qs = do

373returningWith parser conn q qs = do

@@ -508,7 +517,7 @@ fold_ :: (FromRow r) =>

508 -> IO a

517 -> IO a

509fold_ = foldWithOptions_ defaultFoldOptions

518fold_ = foldWithOptions_ defaultFoldOptions

510

519

511−-- | A version of 'foldWith' taking a parser as an argument

520+-- | A version of 'fold_' taking a parser as an argument

512foldWith_ :: RowParser r

521foldWith_ :: RowParser r

513 -> Connection

522 -> Connection

514 -> Query

523 -> Query

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

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

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

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

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

526 -> IO a

535 -> IO a

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

528

537

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

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

530foldWithOptionsAndParser_ :: FoldOptions

539foldWithOptionsAndParser_ :: FoldOptions

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

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

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

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

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

536 -> IO a

545 -> IO a

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

538

547

539doFold :: FoldOptions

548doFold :: FoldOptions

540 -> RowParser row

549 -> RowParser row

@@ -562,28 +571,17 @@ doFold FoldOptions{..} parser conn _template q a0 f = do

562 PQ.TransUnknown -> fail "foldWithOpts FIXME: PQ.TransUnknown"

571 PQ.TransUnknown -> fail "foldWithOpts FIXME: PQ.TransUnknown"

563 -- Not sure what this means.

572 -- Not sure what this means.

564 where

573 where

565− declare = do

574+ declare =

566− name <- newTempName conn

575+ declareCursor conn q

567− _ <- execute_ conn $ mconcat

576+ fetch cursor a =

568− [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]

577+ foldForwardWithParser cursor parser chunkSize f a

569− return name

578+

570− fetch (Query name) = queryWith_ parser conn $

571− Query (toByteString (byteString "FETCH FORWARD "

572− <> intDec chunkSize

573− <> byteString " FROM "

574− <> byteString name

575− ))

576− close name =

577− (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->

578− -- Don't throw exception if CLOSE failed because the transaction is

579− -- aborted. Otherwise, it will throw away the original error.

580− if isFailedTransactionError ex then return () else throwIO ex

581−

582− go = bracket declare close $ \name ->

579+ go = bracket declare closeCursor $ \cursor ->

583− let loop a = do

580+ let loop a = fetch cursor a >>=

584− rs <- fetch name

581+ \r -> case r of

585− if null rs then return a else foldM f a rs >>= loop

582+ Left x -> return x

583+ Right x -> loop x

586− in loop a0

584+ in loop a0

587

585

588-- FIXME: choose the Automatic chunkSize more intelligently

586-- FIXME: choose the Automatic chunkSize more intelligently

589-- One possibility is to use the type of the results, although this

587-- One possibility is to use the type of the results, although this

@@ -633,64 +631,6 @@ forEachWith_ :: RowParser r

633forEachWith_ parser conn template = foldWith_ parser conn template () . const

631forEachWith_ parser conn template = foldWith_ parser conn template () . const

634{-# INLINE forEachWith_ #-}

632{-# INLINE forEachWith_ #-}

635

633

636−forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]

637−forM' lo hi m = loop hi []

638− where

639− loop !n !as

640− | n < lo = return as

641− | otherwise = do

642− a <- m n

643− loop (n-1) (a:as)

644−

645−finishQuery :: FromRow r => Connection -> Query -> PQ.Result -> IO [r]

646−finishQuery = finishQueryWith fromRow

647−

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

649−finishQueryWith parser conn q result = do

650− status <- PQ.resultStatus result

651− case status of

652− PQ.EmptyQuery ->

653− throwIO $ QueryError "query: Empty query" q

654− PQ.CommandOk -> do

655− throwIO $ QueryError "query resulted in a command response" q

656− PQ.TuplesOk -> do

657− let unCol (PQ.Col x) = fromIntegral x :: Int

658− nrows <- PQ.ntuples result

659− ncols <- PQ.nfields result

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

661− let rw = Row row result

662− okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn

663− case okvc of

664− Ok (val,col) | col == ncols -> return val

665− | otherwise -> do

666− vals <- forM' 0 (ncols-1) $ \c -> do

667− tinfo <- getTypeInfo conn =<< PQ.ftype result c

668− v <- PQ.getvalue result row c

669− return ( tinfo

670− , fmap ellipsis v )

671− throw (ConversionFailed

672− (show (unCol ncols) ++ " values: " ++ show vals)

673− Nothing

674− ""

675− (show (unCol col) ++ " slots in target type")

676− "mismatch between number of columns to \

677− \convert and number in target type")

678− Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"

679− Errors [x] -> throwIO x

680− Errors xs -> throwIO $ ManyErrors xs

681− PQ.CopyOut ->

682− throwIO $ QueryError "query: COPY TO is not supported" q

683− PQ.CopyIn ->

684− throwIO $ QueryError "query: COPY FROM is not supported" q

685− PQ.BadResponse -> throwResultError "query" result status

686− PQ.NonfatalError -> throwResultError "query" result status

687− PQ.FatalError -> throwResultError "query" result status

688−

689−ellipsis :: ByteString -> ByteString

690−ellipsis bs

691− | B.length bs > 15 = B.take 10 bs `B.append` "[...]"

692− | otherwise = bs

693−

694

634

695-- $use

635-- $use

696--

636--

@@ -962,7 +902,7 @@ ellipsis bs

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

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

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

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

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

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

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

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

966--

906--

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

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

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

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

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

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

42quoted :: Parser ByteString

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

44 where

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

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

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

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

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

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

50-- not containing the delimiter character.

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

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

12 ) where

14import qualified Control.Exception as E

15−import Data.Monoid

16import Data.ByteString (ByteString)

15import Data.ByteString (ByteString)

17import Data.ByteString.Lazy (toStrict)

16import Data.ByteString.Lazy (toStrict)

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

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

19−

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

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

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

22−#else

23−import Data.Scientific (scientificBuilder)

24−#endif

25−

26−#if __GLASGOW_HASKELL__ >= 702

27import System.IO.Unsafe (unsafeDupablePerformIO)

19import System.IO.Unsafe (unsafeDupablePerformIO)

28−#elif __GLASGOW_HASKELL__ >= 611

29−import GHC.IO (unsafeDupablePerformIO)

30−#else

31−import GHC.IOBase (unsafeDupablePerformIO)

32−#endif

33−

34import Data.Fixed (Pico)

20import Data.Fixed (Pico)

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

36import Data.Fixed (Fixed(MkFixed))

21import Data.Fixed (Fixed(MkFixed))

37−#else

38−import Unsafe.Coerce (unsafeCoerce)

39−#endif

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

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

42--

24--

@@ -46,40 +28,14 @@ import Unsafe.Coerce (unsafeCoerce)

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

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

47-- don't need that polymorphism.

29-- don't need that polymorphism.

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

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

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

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

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

51−#else

52−mask io = do

53− b <- E.blocked

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

55−#endif

56{-# INLINE mask #-}

32{-# INLINE mask #-}

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

59−infixr 6 <>

60−

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

62−(<>) = mappend

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

64−#endif

65−

66toByteString :: Builder -> ByteString

34toByteString :: Builder -> ByteString

67toByteString x = toStrict (toLazyByteString x)

35toByteString x = toStrict (toLazyByteString x)

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

70−

71toPico :: Integer -> Pico

37toPico :: Integer -> Pico

72toPico = MkFixed

38toPico = MkFixed

74fromPico :: Pico -> Integer

40fromPico :: Pico -> Integer

75fromPico (MkFixed i) = i

41fromPico (MkFixed i) = i

76−

77−#else

78−

79−toPico :: Integer -> Pico

80−toPico = unsafeCoerce

81−

82−fromPico :: Pico -> Integer

83−fromPico = unsafeCoerce

84−

85−#endif

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

@@ -9,7 +9,7 @@

9-- Stability: experimental

10--

11-- mid-level support for COPY IN and COPY OUT. See

12−-- <http://www.postgresql.org/docs/9.2/static/sql-copy.html> for

12+-- <https://www.postgresql.org/docs/9.5/static/sql-copy.html> for

13-- more information.

14--

15-- To use this binding, first call 'copy' with an appropriate

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

32 ( copy

33 , copy_

34 , CopyOutResult(..)

35+ , foldCopyData

35 , getCopyData

36 , getCopyData

36 , putCopyData

37 , putCopyData

37 , putCopyEnd

38 , putCopyEnd

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

48import qualified Database.PostgreSQL.LibPQ as PQ

49import qualified Database.PostgreSQL.LibPQ as PQ

49import Database.PostgreSQL.Simple

50import Database.PostgreSQL.Simple

50import Database.PostgreSQL.Simple.Types

51import Database.PostgreSQL.Simple.Types

51−import Database.PostgreSQL.Simple.Internal

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

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

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

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

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

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

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

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

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

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

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

60copy conn template qs = do

61copy conn template qs = do

@@ -75,15 +76,18 @@ doCopy :: B.ByteString -> Connection -> Query -> B.ByteString -> IO ()

75doCopy funcName conn template q = do

76doCopy funcName conn template q = do

76 result <- exec conn q

77 result <- exec conn q

77 status <- PQ.resultStatus result

78 status <- PQ.resultStatus result

78− let err = throwIO $ QueryError

79+ let errMsg msg = throwIO $ QueryError

79− (B.unpack funcName ++ " " ++ show status)

80+ (B.unpack funcName ++ " " ++ msg)

80 template

81 template

82+ let err = errMsg $ show status

81 case status of

83 case status of

82 PQ.EmptyQuery -> err

84 PQ.EmptyQuery -> err

83 PQ.CommandOk -> err

85 PQ.CommandOk -> err

84 PQ.TuplesOk -> err

86 PQ.TuplesOk -> err

85 PQ.CopyOut -> return ()

87 PQ.CopyOut -> return ()

86 PQ.CopyIn -> return ()

88 PQ.CopyIn -> return ()

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

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

87 PQ.BadResponse -> throwResultError funcName result status

91 PQ.BadResponse -> throwResultError funcName result status

88 PQ.NonfatalError -> throwResultError funcName result status

92 PQ.NonfatalError -> throwResultError funcName result status

89 PQ.FatalError -> throwResultError funcName result status

93 PQ.FatalError -> throwResultError funcName result status

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

97 deriving (Eq, Typeable, Show)

101 deriving (Eq, Typeable, Show)

102

103

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

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

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

107+--

108+-- __Example__

109+--

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

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

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

113+-- > []

114+

115+foldCopyData

116+ :: Connection -- ^ Database connection

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

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

119+ -> a -- ^ Initial accumulator

120+ -> IO b -- ^ Result

121+foldCopyData conn f g !acc = do

122+ result <- getCopyData conn

123+ case result of

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

125+ CopyOutDone count -> g acc count

126+

127+

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

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

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

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

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

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

@@ -224,7 +252,9 @@ getCopyCommandTag funcName pqconn = do

224 consumeResults pqconn

252 consumeResults pqconn

225 let rowCount = P.string "COPY " *> (P.decimal <* P.endOfInput)

253 let rowCount = P.string "COPY " *> (P.decimal <* P.endOfInput)

226 case P.parseOnly rowCount cmdStat of

254 case P.parseOnly rowCount cmdStat of

255+ Left _ -> do mmsg <- PQ.errorMessage pqconn

227− Left _ -> fail errCmdStatusFmt

256+ fail $ errCmdStatusFmt

257+ ++ maybe "" (\msg -> "\nConnection error: "++B.unpack msg) mmsg

228 Right n -> return $! n

258 Right n -> return $! n

229 where

259 where

230 errCmdStatus = B.unpack funcName ++ ": failed to fetch command status"

260 errCmdStatus = B.unpack funcName ++ ": failed to fetch command status"

src/Database/PostgreSQL/Simple/Cursor.hsnew file+98

@@ -0,0 +1,98 @@

1+{-# LANGUAGE OverloadedStrings #-}

3+------------------------------------------------------------------------------

4+-- |

5+-- Module: Database.PostgreSQL.Simple.Cursor

8+-- License: BSD3

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

10+--

11+------------------------------------------------------------------------------

12+

13+module Database.PostgreSQL.Simple.Cursor

14+ (

15+ -- * Types

16+ Cursor

17+ -- * Cursor management

18+ , declareCursor

19+ , closeCursor

20+ -- * Folding over rows from a cursor

21+ , foldForward

22+ , foldForwardWithParser

23+ ) where

24+

25+import Data.ByteString.Builder (intDec)

26+import Control.Applicative ((<$>))

27+import Control.Exception as E

28+import Control.Monad (unless, void)

29+import Data.Monoid (mconcat)

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

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

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

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

34+import Database.PostgreSQL.Simple.Internal.PQResultUtils

35+import Database.PostgreSQL.Simple.Transaction

36+import qualified Database.PostgreSQL.LibPQ as PQ

37+

38+-- | Cursor within a transaction.

39+data Cursor = Cursor !Query !Connection

40+

41+-- | Declare a temporary cursor. The cursor is given a

42+-- unique name for the given connection.

43+declareCursor :: Connection -> Query -> IO Cursor

44+declareCursor conn q = do

45+ name <- newTempName conn

46+ void $ execute_ conn $ mconcat ["DECLARE ", name, " NO SCROLL CURSOR FOR ", q]

47+ return $ Cursor name conn

48+

49+-- | Close the given cursor.

50+closeCursor :: Cursor -> IO ()

51+closeCursor (Cursor name conn) =

52+ (void $ execute_ conn ("CLOSE " <> name)) `E.catch` \ex ->

53+ -- Don't throw exception if CLOSE failed because the transaction is

54+ -- aborted. Otherwise, it will throw away the original error.

55+ unless (isFailedTransactionError ex) $ throwIO ex

56+

57+-- | Fold over a chunk of rows from the given cursor, calling the

58+-- supplied fold-like function on each row as it is received. In case

59+-- the cursor is exhausted, a 'Left' value is returned, otherwise a

60+-- 'Right' value is returned.

61+foldForwardWithParser :: Cursor -> RowParser r -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)

62+foldForwardWithParser (Cursor name conn) parser chunkSize f a0 = do

63+ let q = "FETCH FORWARD "

64+ <> (toByteString $ intDec chunkSize)

65+ <> " FROM "

66+ <> fromQuery name

67+ result <- exec conn q

68+ status <- PQ.resultStatus result

69+ case status of

70+ PQ.TuplesOk -> do

71+ nrows <- PQ.ntuples result

72+ ncols <- PQ.nfields result

73+ if nrows > 0

74+ then do

75+ let inner a row = do

76+ x <- getRowWith parser row ncols conn result

77+ f a x

78+ Right <$> foldM' inner a0 0 (nrows - 1)

79+ else

80+ return $ Left a0

81+ _ -> throwResultError "foldForwardWithParser" result status

82+

83+-- | Fold over a chunk of rows, calling the supplied fold-like function

84+-- on each row as it is received. In case the cursor is exhausted,

85+-- a 'Left' value is returned, otherwise a 'Right' value is returned.

86+foldForward :: FromRow r => Cursor -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)

87+foldForward cursor = foldForwardWithParser cursor fromRow

88+

89+

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

91+foldM' f a lo hi = loop a lo

92+ where

93+ loop x !n

94+ | n > hi = return x

95+ | otherwise = do

96+ x' <- f x n

97+ loop x' (n+1)

98+{-# INLINE foldM' #-}

src/Database/PostgreSQL/Simple/Errors.hs+12−11

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

25 )

26 where

28−import Control.Applicative

29import Control.Exception as E

28import Control.Exception as E

31import Data.Attoparsec.ByteString.Char8

30import Data.Attoparsec.ByteString.Char8

@@ -60,16 +59,18 @@ data ConstraintViolation

60 deriving (Show, Eq, Ord, Typeable)

59 deriving (Show, Eq, Ord, Typeable)

62-- Default instance should be enough

61-- Default instance should be enough

63−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

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

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

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

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

68--

69--

69−-- > createUser = catchJust constraintViolation catcher $ execute conn ...

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

70-- > where

71-- > where

71−-- > catcher UniqueViolation "user_login_key" = ...

72+-- > handler (UniqueViolation "user_login_key") = ...

72−-- > catcher _ = ...

73+-- > handler _ = ...

73constraintViolation :: SqlError -> Maybe ConstraintViolation

74constraintViolation :: SqlError -> Maybe ConstraintViolation

74constraintViolation e =

75constraintViolation e =

75 case sqlState e of

76 case sqlState e of

@@ -84,16 +85,16 @@ constraintViolation e =

85-- | Like constraintViolation, but also packs original SqlError.

86-- | Like constraintViolation, but also packs original SqlError.

86--

87--

87−-- > createUser = catchJust constraintViolationE catcher $ execute conn ...

88+-- > createUser = handleJust constraintViolationE handler $ execute conn ...

88-- > where

89-- > where

89−-- > catcher (_, UniqueViolation "user_login_key") = ...

90+-- > handler (_, UniqueViolation "user_login_key") = ...

90−-- > catcher (e, _) = throwIO e

91+-- > handler (e, _) = throwIO e

91--

92--

92constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)

93constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)

93constraintViolationE e = fmap ((,) e) $ constraintViolation e

94constraintViolationE e = fmap ((,) e) $ constraintViolation e

95-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws

96-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws

96−-- on fail. Provides alternative interface to catchJust

97+-- on fail. Provides alternative interface to 'E.handleJust'

97--

98--

98-- > createUser = catchViolation catcher $ execute conn ...

99-- > createUser = catchViolation catcher $ execute conn ...

99-- > where

100-- > where

@@ -124,7 +125,7 @@ parseMaybe p b = either (const Nothing) Just $ parseOnly p b

124------------------------------------------------------------------------

125------------------------------------------------------------------------

125-- Error predicates

126-- Error predicates

126--

127--

127−-- http://www.postgresql.org/docs/current/static/errcodes-appendix.html

128+-- https://www.postgresql.org/docs/9.5/static/errcodes-appendix.html

128

129

129isSerializationError :: SqlError -> Bool

130isSerializationError :: SqlError -> Bool

130isSerializationError = isSqlState "40001"

131isSerializationError = isSqlState "40001"

src/Database/PostgreSQL/Simple/FromField.hs+152−77

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

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

2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

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

4+{-# LANGUAGE RecordWildCards #-}

5+{-# LANGUAGE PolyKinds #-}

6{- |

7{- |

7Module: Database.PostgreSQL.Simple.FromField

8Module: Database.PostgreSQL.Simple.FromField

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

106 , PQ.Oid(..)

107 , PQ.Oid(..)

107 , PQ.Format(..)

108 , PQ.Format(..)

108 , pgArrayFieldParser

109 , pgArrayFieldParser

110+ , attoFieldParser

109

111

112+ , optionalField

110 , fromJSONField

113 , fromJSONField

114+ , fromFieldJSONByteString

111 ) where

115 ) where

112

116

113#include "MachDeps.h"

117#include "MachDeps.h"

114

118

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

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

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

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

117−import Control.Exception (Exception)

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

118import qualified Data.Aeson as JSON

122import qualified Data.Aeson as JSON

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

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

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

121import Data.ByteString (ByteString)

124import Data.ByteString (ByteString)

122import qualified Data.ByteString.Char8 as B

125import qualified Data.ByteString.Char8 as B

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

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

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

124import Data.IORef (IORef, newIORef)

128import Data.IORef (IORef, newIORef)

125import Data.Ratio (Ratio)

129import Data.Ratio (Ratio)

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

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

127import Data.Typeable (Typeable, typeOf)

131import Data.Typeable (Typeable, typeOf)

128import Data.Vector (Vector)

132import Data.Vector (Vector)

129import Data.Vector.Mutable (IOVector)

133import Data.Vector.Mutable (IOVector)

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

134import Database.PostgreSQL.Simple.Types

138import Database.PostgreSQL.Simple.Types

135import Database.PostgreSQL.Simple.TypeInfo as TI

139import Database.PostgreSQL.Simple.TypeInfo as TI

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

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

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

138import Database.PostgreSQL.Simple.Time

141import Database.PostgreSQL.Simple.Time

139import Database.PostgreSQL.Simple.Arrays as Arrays

142import Database.PostgreSQL.Simple.Arrays as Arrays

140import qualified Database.PostgreSQL.LibPQ as PQ

143import qualified Database.PostgreSQL.LibPQ as PQ

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

151import Data.Scientific (Scientific)

154import Data.Scientific (Scientific)

152import GHC.Real (infinity, notANumber)

155import GHC.Real (infinity, notANumber)

153

156

157+import qualified Data.Aeson.Types as JSON

158+

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

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

155-- value fails.

160-- value fails.

156data ResultError = Incompatible { errSQLType :: String

161data ResultError = Incompatible { errSQLType :: String

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

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

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

178 deriving (Eq, Show, Typeable)

183 deriving (Eq, Show, Typeable)

179

184

180−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

181

188

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

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

183left = conversionError

190left = conversionError

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

243 then Nothing

250 then Nothing

244 else Just x

251 else Just x

245

252

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

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

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

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

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

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

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

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

249

258

250tableColumn :: Field -> Int

259tableColumn :: Field -> Int

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

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

@@ -261,16 +270,33 @@ format Field{..} = unsafeDupablePerformIO (PQ.fformat result column)

261-- | void

270-- | void

262instance FromField () where

271instance FromField () where

263 fromField f _bs

272 fromField f _bs

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

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

265 | otherwise = pure ()

274 | otherwise = pure ()

266

275

276+instance (FromField a) => FromField (Const a b) where

277+ fromField f bs = Const <$> fromField f bs

278+

279+instance (FromField a) => FromField (Identity a) where

280+ fromField f bs = Identity <$> fromField f bs

281+

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

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

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

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

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

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

270-- behavior.

285-- behavior.

271−instance (FromField a) => FromField (Maybe a) where

286+instance FromField a => FromField (Maybe a) where

287+ fromField = optionalField fromField

288+

289+-- | For dealing with SQL @null@ values outside of the 'FromField' class.

290+-- Alternatively, one could use 'Control.Applicative.optional', but that

291+-- also turns type and conversion errors into 'Nothing', whereas this is

292+-- more specific and turns only @null@ values into 'Nothing'.

293+

294+optionalField :: FieldParser a -> FieldParser (Maybe a)

295+optionalField p f mv =

296+ case mv of

272− fromField _ Nothing = pure Nothing

297+ Nothing -> pure Nothing

273− fromField f bs = Just <$> fromField f bs

298+ Just _ -> Just <$> p f mv

299+{-# INLINE optionalField #-}

274

300

275-- | compatible with any data type, but the value must be null

301-- | compatible with any data type, but the value must be null

276instance FromField Null where

302instance FromField Null where

@@ -280,30 +306,30 @@ instance FromField Null where

280-- | bool

306-- | bool

281instance FromField Bool where

307instance FromField Bool where

282 fromField f bs

308 fromField f bs

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

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

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

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

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

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

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

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

287 | otherwise = returnError ConversionFailed f ""

313 | otherwise = returnError ConversionFailed f ""

288

314

289−-- | \"char\"

315+-- | \"char\", bpchar

290instance FromField Char where

316instance FromField Char where

291− fromField f bs =

317+ fromField f bs0 =

292− if typeOid f /= $(inlineTypoid TI.char)

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

293− then returnError Incompatible f ""

294− else case bs of

319+ then case bs0 of

295 Nothing -> returnError UnexpectedNull f ""

320 Nothing -> returnError UnexpectedNull f ""

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

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

297 then returnError ConversionFailed f "length not 1"

322 then returnError ConversionFailed f "length not 1"

298 else return $! (B.head bs)

323 else return $! (B.head bs)

324+ else returnError Incompatible f ""

299

325

300-- | int2

326-- | int2

301instance FromField Int16 where

327instance FromField Int16 where

302− fromField = atto ok16 $ signed decimal

328+ fromField = attoFieldParser ok16 $ signed decimal

303

329

304-- | int2, int4

330-- | int2, int4

305instance FromField Int32 where

331instance FromField Int32 where

306− fromField = atto ok32 $ signed decimal

332+ fromField = attoFieldParser ok32 $ signed decimal

307

333

308#if WORD_SIZE_IN_BITS < 64

334#if WORD_SIZE_IN_BITS < 64

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

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

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

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

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

314#endif

340#endif

315instance FromField Int where

341instance FromField Int where

316− fromField = atto okInt $ signed decimal

342+ fromField = attoFieldParser okInt $ signed decimal

317

343

318-- | int2, int4, int8

344-- | int2, int4, int8

319instance FromField Int64 where

345instance FromField Int64 where

320− fromField = atto ok64 $ signed decimal

346+ fromField = attoFieldParser ok64 $ signed decimal

321

347

322-- | int2, int4, int8

348-- | int2, int4, int8

323instance FromField Integer where

349instance FromField Integer where

324− fromField = atto ok64 $ signed decimal

350+ fromField = attoFieldParser ok64 $ signed decimal

325

351

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

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

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

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

328instance FromField Float where

354instance FromField Float where

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

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

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

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

331

357

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

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

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

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

334instance FromField Double where

360instance FromField Double where

335− fromField = atto ok pg_double

361+ fromField = attoFieldParser ok pg_double

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

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

337

363

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

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

339instance FromField (Ratio Integer) where

365instance FromField (Ratio Integer) where

340− fromField = atto ok pg_rational

366+ fromField = attoFieldParser ok pg_rational

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

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

342

368

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

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

344instance FromField Scientific where

370instance FromField Scientific where

345− fromField = atto ok rational

371+ fromField = attoFieldParser ok rational

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

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

347

373

348unBinary :: Binary t -> t

374unBinary :: Binary t -> t

349unBinary (Binary x) = x

375unBinary (Binary x) = x

@@ -364,13 +390,13 @@ pg_rational

364

390

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

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

366instance FromField SB.ByteString where

392instance FromField SB.ByteString where

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

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

368 then unBinary <$> fromField f dat

394 then unBinary <$> fromField f dat

369 else doFromField f okText' pure dat

395 else doFromField f okText' pure dat

370

396

371-- | oid

397-- | oid

372instance FromField PQ.Oid where

398instance FromField PQ.Oid where

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

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

374

400

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

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

376instance FromField LB.ByteString where

402instance FromField LB.ByteString where

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

378

404

379unescapeBytea :: Field -> SB.ByteString

405unescapeBytea :: Field -> SB.ByteString

380 -> Conversion (Binary SB.ByteString)

406 -> Conversion (Binary SB.ByteString)

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

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

382 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

408 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

383 Just str -> pure (Binary str)

409 Just str -> pure (Binary str)

384

410

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

429

455

430-- | timestamptz

456-- | timestamptz

431instance FromField UTCTime where

457instance FromField UTCTime where

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

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

433

459

434-- | timestamptz

460-- | timestamptz

435instance FromField ZonedTime where

461instance FromField ZonedTime where

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

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

437

463

438-- | timestamp

464-- | timestamp

439instance FromField LocalTime where

465instance FromField LocalTime where

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

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

441

467

442-- | date

468-- | date

443instance FromField Day where

469instance FromField Day where

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

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

445

471

446-- | time

472-- | time

447instance FromField TimeOfDay where

473instance FromField TimeOfDay where

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

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

449

475

450-- | timestamptz

476-- | timestamptz

451instance FromField UTCTimestamp where

477instance FromField UTCTimestamp where

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

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

453

479

454-- | timestamptz

480-- | timestamptz

455instance FromField ZonedTimestamp where

481instance FromField ZonedTimestamp where

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

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

457

483

458-- | timestamp

484-- | timestamp

459instance FromField LocalTimestamp where

485instance FromField LocalTimestamp where

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

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

461

487

462-- | date

488-- | date

463instance FromField Date where

489instance FromField Date where

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

465

500

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

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

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

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

468−ff compatOid hsType parse f mstr =

503+ff compatOid hsType parseBS f mstr =

469 if typeOid f /= compatOid

504 if typeOid f /= compatOid

470 then err Incompatible ""

505 then err Incompatible ""

471 else case mstr of

506 else case mstr of

472 Nothing -> err UnexpectedNull ""

507 Nothing -> err UnexpectedNull ""

473− Just str -> case parse str of

508+ Just str -> case parseBS str of

474 Left msg -> err ConversionFailed msg

509 Left msg -> err ConversionFailed msg

475 Right val -> return val

510 Right val -> return val

476 where

511 where

@@ -508,13 +543,13 @@ pgArrayFieldParser fieldParser f mdat = do

508 _ -> returnError Incompatible f ""

543 _ -> returnError Incompatible f ""

509

544

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

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

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

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

512 where

547 where

513− delim = typdelim (typelem typeInfo)

548+ delim = typdelim (typelem typInfo)

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

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

515

550

516 parseIt item =

551 parseIt item =

517− fieldParser f' $ if item' == "NULL" then Nothing else Just item'

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

518 where

553 where

519 item' = fmt delim item

554 item' = fmt delim item

520 f' | Arrays.Array _ <- item = f

555 f' | Arrays.Array _ <- item = f

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

529-- | uuid

564-- | uuid

530instance FromField UUID where

565instance FromField UUID where

531 fromField f mbs =

566 fromField f mbs =

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

567+ if typeOid f /= TI.uuidOid

533 then returnError Incompatible f ""

568 then returnError Incompatible f ""

534 else case mbs of

569 else case mbs of

535 Nothing -> returnError UnexpectedNull f ""

570 Nothing -> returnError UnexpectedNull f ""

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

538 Nothing -> returnError ConversionFailed f "Invalid UUID"

573 Nothing -> returnError ConversionFailed f "Invalid UUID"

539 Just uuid -> pure uuid

574 Just uuid -> pure uuid

540

575

541−-- | json

576+-- | json, jsonb

542instance FromField JSON.Value where

577instance FromField JSON.Value where

543− fromField f mbs =

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

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

580+ Left err -> returnError ConversionFailed f err

581+ Right val -> pure val

582+

583+-- | Return the JSON ByteString directly

584+--

585+-- @since 0.6.3

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

587+fromFieldJSONByteString f mbs =

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

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

545 then returnError Incompatible f ""

589 then returnError Incompatible f ""

546 else case mbs of

590 else case mbs of

547 Nothing -> returnError UnexpectedNull f ""

591 Nothing -> returnError UnexpectedNull f ""

548− Just bs ->

592+ Just bs -> pure bs

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

550− Left err -> returnError ConversionFailed f err

551− Right val -> pure val

552

593

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

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

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

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

555--

596--

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

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

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

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

@@ -559,14 +600,23 @@ instance FromField JSON.Value where

559--

600--

560-- The 'Typeable' constraint is required to show more informative

601-- The 'Typeable' constraint is required to show more informative

561-- error messages when parsing fails.

602-- error messages when parsing fails.

603+--

604+-- Note that @fromJSONField :: FieldParser ('Maybe' Foo)@ will return

605+-- @'Nothing'@ on the json @null@ value, and return an exception on SQL @null@

606+-- value. Alternatively, one could write @'optionalField' fromJSONField@

607+-- that will return @Nothing@ on SQL @null@, and otherwise will call

608+-- @fromJSONField :: FieldParser Foo@ and then return @'Just'@ the

609+-- result value, or return its exception. If one would

610+-- like to return @Nothing@ on both the SQL @null@ and json @null@ values,

611+-- one way to do it would be to write

612+-- @\\f mv -> 'Control.Monad.join' '<$>' optionalField fromJSONField f mv@

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

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

563fromJSONField f mbBs = do

614fromJSONField f mbBs = do

564 value <- fromField f mbBs

615 value <- fromField f mbBs

565− case JSON.fromJSON value of

616+ case JSON.ifromJSON value of

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

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

567− "JSON decoding error: " ++ err

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

568− JSON.Success x -> pure x

619+ JSON.ISuccess x -> pure x

569−

570

620

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

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

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

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

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

583type Compat = PQ.Oid -> Bool

633type Compat = PQ.Oid -> Bool

584

634

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

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

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

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

587− TI.bpchar, TI.varchar ] )

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

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

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

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

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

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

640+okBinary = eq TI.byteaOid

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

641+ok16 = eq TI.int2Oid

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

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

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

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

594#if WORD_SIZE_IN_BITS < 64

644#if WORD_SIZE_IN_BITS < 64

595okInt = ok32

645okInt = ok32

596#else

646#else

597okInt = ok64

647okInt = ok64

598#endif

648#endif

599

649

650+-- | eq and \/ are used to imlement what Macro stuff did,

651+-- i.e. mkCompats and inlineTypoid

652+eq :: PQ.Oid -> PQ.Oid -> Bool

653+eq = (==)

654+{-# INLINE eq #-}

655+

656+infixr 2 \/

657+(\/) :: (PQ.Oid -> Bool)

658+ -> (PQ.Oid -> Bool)

659+ -> (PQ.Oid -> Bool)

660+f \/ g = \x -> f x || g x

661+{-# INLINE (\/) #-}

662+

600doFromField :: forall a . (Typeable a)

663doFromField :: forall a . (Typeable a)

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

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

602 -> Maybe ByteString -> Conversion a

665 -> Maybe ByteString -> Conversion a

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

621 (show (typeOf (undefined :: a)))

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

622 msg

685 msg

623

686

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

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

689+--

690+-- @

691+-- instance FromField Int16 where

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

693+-- @

694+--

695+-- @since 0.6.3

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

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

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

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

626− -> Conversion a

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

699+ -> Parser a

700+ -- ^ An attoparsec parser.

701+ -> FieldParser a

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

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

628 where

703 where

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

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

630 go p s =

705 go p s =

src/Database/PostgreSQL/Simple/FromRow.hs+239−6

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

1+{-# LANGUAGE FlexibleContexts #-}

1−{-# LANGUAGE RecordWildCards, FlexibleInstances #-}

2+{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}

3------------------------------------------------------------------------------

5------------------------------------------------------------------------------

4-- |

6-- |

@@ -27,7 +29,7 @@ module Database.PostgreSQL.Simple.FromRow

27 ) where

29 ) where

29import Prelude hiding (null)

31import Prelude hiding (null)

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

32+import Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)

31import Control.Monad (replicateM, replicateM_)

33import Control.Monad (replicateM, replicateM_)

32import Control.Monad.Trans.State.Strict

34import Control.Monad.Trans.State.Strict

33import Control.Monad.Trans.Reader

35import Control.Monad.Trans.Reader

@@ -45,13 +47,17 @@ import Database.PostgreSQL.Simple.Ok

45import Database.PostgreSQL.Simple.Types ((:.)(..), Null)

47import Database.PostgreSQL.Simple.Types ((:.)(..), Null)

46import Database.PostgreSQL.Simple.TypeInfo

48import Database.PostgreSQL.Simple.TypeInfo

50+import GHC.Generics

51+

52+

48-- | A collection type that can be converted from a sequence of fields.

53-- | A collection type that can be converted from a sequence of fields.

49-- Instances are provided for tuples up to 10 elements and lists of any length.

54-- Instances are provided for tuples up to 10 elements and lists of any length.

50--

55--

51-- Note that instances can be defined outside of postgresql-simple, which is

56-- Note that instances can be defined outside of postgresql-simple, which is

52-- often useful. For example, here's an instance for a user-defined pair:

57-- often useful. For example, here's an instance for a user-defined pair:

53--

58--

59+-- @

54−-- @data User = User { name :: String, fileQuota :: Int }

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

55--

61--

56-- instance 'FromRow' User where

62-- instance 'FromRow' User where

57-- fromRow = User \<$\> 'field' \<*\> 'field'

63-- fromRow = User \<$\> 'field' \<*\> 'field'

@@ -61,13 +67,32 @@ import Database.PostgreSQL.Simple.TypeInfo

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

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

62-- exception will be thrown.

68-- exception will be thrown.

63--

69--

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

71+-- this:

72+--

73+-- @

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

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

76+--

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

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

79+--

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

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

82+-- @

83+--

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

85+-- support sum types or recursive types.

86+--

64−-- Note that 'field' evaluates it's result to WHNF, so the caveats listed in

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

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

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

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

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

67-- of 'fromField'.

90-- of 'fromField'.

69class FromRow a where

92class FromRow a where

70 fromRow :: RowParser a

93 fromRow :: RowParser a

94+ default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a

95+ fromRow = to <$> gfromRow

72getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString

97getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString

73getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)

98getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)

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

106 else do

131 else do

107 let !result = rowresult

132 let !result = rowresult

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

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

109− !field = Field{..}

134+ !field' = Field{..}

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

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

111

136

112field :: FromField a => RowParser a

137field :: FromField a => RowParser a

113field = fieldWith fromField

138field = fieldWith fromField

@@ -230,6 +255,196 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,

230 null *> null *> null *> null *> null *> pure Nothing)

255 null *> null *> null *> null *> null *> pure Nothing)

231 <|> (Just <$> fromRow)

256 <|> (Just <$> fromRow)

232

257

258+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

259+ FromField f, FromField g, FromField h, FromField i, FromField j,

260+ FromField k) =>

261+ FromRow (a,b,c,d,e,f,g,h,i,j,k) where

262+ fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

263+ <*> field <*> field <*> field <*> field <*> field

264+ <*> field

265+

266+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

267+ FromField f, FromField g, FromField h, FromField i, FromField j,

268+ FromField k) =>

269+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k)) where

270+ fromRow = (null *> null *> null *> null *> null *>

271+ null *> null *> null *> null *> null *>

272+ null *> pure Nothing)

273+ <|> (Just <$> fromRow)

274+

275+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

276+ FromField f, FromField g, FromField h, FromField i, FromField j,

277+ FromField k, FromField l) =>

278+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where

279+ fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

280+ <*> field <*> field <*> field <*> field <*> field

281+ <*> field <*> field

282+

283+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

284+ FromField f, FromField g, FromField h, FromField i, FromField j,

285+ FromField k, FromField l) =>

286+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l)) where

287+ fromRow = (null *> null *> null *> null *> null *>

288+ null *> null *> null *> null *> null *>

289+ null *> null *> pure Nothing)

290+ <|> (Just <$> fromRow)

291+

292+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

293+ FromField f, FromField g, FromField h, FromField i, FromField j,

294+ FromField k, FromField l, FromField m) =>

295+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where

296+ fromRow = (,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

297+ <*> field <*> field <*> field <*> field <*> field

298+ <*> field <*> field <*> field

299+

300+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

301+ FromField f, FromField g, FromField h, FromField i, FromField j,

302+ FromField k, FromField l, FromField m) =>

303+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m)) where

304+ fromRow = (null *> null *> null *> null *> null *>

305+ null *> null *> null *> null *> null *>

306+ null *> null *> null *> pure Nothing)

307+ <|> (Just <$> fromRow)

308+

309+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

310+ FromField f, FromField g, FromField h, FromField i, FromField j,

311+ FromField k, FromField l, FromField m, FromField n) =>

312+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where

313+ fromRow = (,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

314+ <*> field <*> field <*> field <*> field <*> field

315+ <*> field <*> field <*> field <*> field

316+

317+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

318+ FromField f, FromField g, FromField h, FromField i, FromField j,

319+ FromField k, FromField l, FromField m, FromField n) =>

320+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n)) where

321+ fromRow = (null *> null *> null *> null *> null *>

322+ null *> null *> null *> null *> null *>

323+ null *> null *> null *> null *> pure Nothing)

324+ <|> (Just <$> fromRow)

325+

326+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

327+ FromField f, FromField g, FromField h, FromField i, FromField j,

328+ FromField k, FromField l, FromField m, FromField n, FromField o) =>

329+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where

330+ fromRow = (,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

331+ <*> field <*> field <*> field <*> field <*> field

332+ <*> field <*> field <*> field <*> field <*> field

333+

334+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

335+ FromField f, FromField g, FromField h, FromField i, FromField j,

336+ FromField k, FromField l, FromField m, FromField n, FromField o) =>

337+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)) where

338+ fromRow = (null *> null *> null *> null *> null *>

339+ null *> null *> null *> null *> null *>

340+ null *> null *> null *> null *> null *> pure Nothing)

341+ <|> (Just <$> fromRow)

342+

343+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

344+ FromField f, FromField g, FromField h, FromField i, FromField j,

345+ FromField k, FromField l, FromField m, FromField n, FromField o,

346+ FromField p) =>

347+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where

348+ fromRow = (,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

349+ <*> field <*> field <*> field <*> field <*> field

350+ <*> field <*> field <*> field <*> field <*> field

351+ <*> field

352+

353+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

354+ FromField f, FromField g, FromField h, FromField i, FromField j,

355+ FromField k, FromField l, FromField m, FromField n, FromField o,

356+ FromField p) =>

357+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)) where

358+ fromRow = (null *> null *> null *> null *> null *>

359+ null *> null *> null *> null *> null *>

360+ null *> null *> null *> null *> null *>

361+ null *> pure Nothing)

362+ <|> (Just <$> fromRow)

363+

364+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

365+ FromField f, FromField g, FromField h, FromField i, FromField j,

366+ FromField k, FromField l, FromField m, FromField n, FromField o,

367+ FromField p, FromField q) =>

368+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where

369+ fromRow = (,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

370+ <*> field <*> field <*> field <*> field <*> field

371+ <*> field <*> field <*> field <*> field <*> field

372+ <*> field <*> field

373+

374+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

375+ FromField f, FromField g, FromField h, FromField i, FromField j,

376+ FromField k, FromField l, FromField m, FromField n, FromField o,

377+ FromField p, FromField q) =>

378+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)) where

379+ fromRow = (null *> null *> null *> null *> null *>

380+ null *> null *> null *> null *> null *>

381+ null *> null *> null *> null *> null *>

382+ null *> null *> pure Nothing)

383+ <|> (Just <$> fromRow)

384+

385+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

386+ FromField f, FromField g, FromField h, FromField i, FromField j,

387+ FromField k, FromField l, FromField m, FromField n, FromField o,

388+ FromField p, FromField q, FromField r) =>

389+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where

390+ fromRow = (,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

391+ <*> field <*> field <*> field <*> field <*> field

392+ <*> field <*> field <*> field <*> field <*> field

393+ <*> field <*> field <*> field

394+

395+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

396+ FromField f, FromField g, FromField h, FromField i, FromField j,

397+ FromField k, FromField l, FromField m, FromField n, FromField o,

398+ FromField p, FromField q, FromField r) =>

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

400+ fromRow = (null *> null *> null *> null *> null *>

401+ null *> null *> null *> null *> null *>

402+ null *> null *> null *> null *> null *>

403+ null *> null *> null *> pure Nothing)

404+ <|> (Just <$> fromRow)

405+

406+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

407+ FromField f, FromField g, FromField h, FromField i, FromField j,

408+ FromField k, FromField l, FromField m, FromField n, FromField o,

409+ FromField p, FromField q, FromField r, FromField s) =>

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

411+ fromRow = (,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

412+ <*> field <*> field <*> field <*> field <*> field

413+ <*> field <*> field <*> field <*> field <*> field

414+ <*> field <*> field <*> field <*> field

415+

416+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

417+ FromField f, FromField g, FromField h, FromField i, FromField j,

418+ FromField k, FromField l, FromField m, FromField n, FromField o,

419+ FromField p, FromField q, FromField r, FromField s) =>

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

421+ fromRow = (null *> null *> null *> null *> null *>

422+ null *> null *> null *> null *> null *>

423+ null *> null *> null *> null *> null *>

424+ null *> null *> null *> null *> pure Nothing)

425+ <|> (Just <$> fromRow)

426+

427+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

428+ FromField f, FromField g, FromField h, FromField i, FromField j,

429+ FromField k, FromField l, FromField m, FromField n, FromField o,

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

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

432+ fromRow = (,,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field

433+ <*> field <*> field <*> field <*> field <*> field

434+ <*> field <*> field <*> field <*> field <*> field

435+ <*> field <*> field <*> field <*> field <*> field

436+

437+instance (FromField a, FromField b, FromField c, FromField d, FromField e,

438+ FromField f, FromField g, FromField h, FromField i, FromField j,

439+ FromField k, FromField l, FromField m, FromField n, FromField o,

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

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

442+ fromRow = (null *> null *> null *> null *> null *>

443+ null *> null *> null *> null *> null *>

444+ null *> null *> null *> null *> null *>

445+ null *> null *> null *> null *> null *> pure Nothing)

446+ <|> (Just <$> fromRow)

447+

233instance FromField a => FromRow [a] where

448instance FromField a => FromRow [a] where

234 fromRow = do

449 fromRow = do

235 n <- numFieldsRemaining

450 n <- numFieldsRemaining

@@ -252,3 +467,21 @@ instance FromField a => FromRow (Maybe (Vector a)) where

252

467

253instance (FromRow a, FromRow b) => FromRow (a :. b) where

468instance (FromRow a, FromRow b) => FromRow (a :. b) where

254 fromRow = (:.) <$> fromRow <*> fromRow

469 fromRow = (:.) <$> fromRow <*> fromRow

470+

471+

472+

473+-- Type class for default implementation of FromRow using generics

474+class GFromRow f where

475+ gfromRow :: RowParser (f p)

476+

477+instance GFromRow f => GFromRow (M1 c i f) where

478+ gfromRow = M1 <$> gfromRow

479+

480+instance (GFromRow f, GFromRow g) => GFromRow (f :*: g) where

481+ gfromRow = liftA2 (:*:) gfromRow gfromRow

482+

483+instance (FromField a) => GFromRow (K1 R a) where

484+ gfromRow = K1 <$> field

485+

486+instance GFromRow U1 where

487+ gfromRow = pure U1

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

@@ -8,14 +8,14 @@

8--

9-- Parsers and printers for hstore, a extended type bundled with

10-- PostgreSQL providing finite maps from text strings to text strings.

11−-- See <http://www.postgresql.org/docs/9.2/static/hstore.html> for more

11+-- See <https://www.postgresql.org/docs/9.5/static/hstore.html> for more

12-- information.

13--

14-- Note that in order to use this type, a database superuser must

15-- install it by running a sql script in the share directory. This

16-- can be done on PostgreSQL 9.1 and later with the command

17-- @CREATE EXTENSION hstore@. See

18−-- <http://www.postgresql.org/docs/9.2/static/contrib.html> for more

18+-- <https://www.postgresql.org/docs/9.5/static/contrib.html> for more

19-- information.

20--

21------------------------------------------------------------------------------

src/Database/PostgreSQL/Simple/HStore/Implementation.hs+11−11

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

22import qualified Data.ByteString.Builder as BU

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

24import qualified Data.ByteString.Lazy as BL

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

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

27−#endif

28import Data.Map(Map)

25import Data.Map(Map)

29import qualified Data.Map as Map

26import qualified Data.Map as Map

30import Data.Text(Text)

27import Data.Text(Text)

@@ -34,6 +31,7 @@ import Data.Text.Encoding.Error(UnicodeException)

34import qualified Data.Text.Lazy as TL

31import qualified Data.Text.Lazy as TL

35import Data.Typeable

32import Data.Typeable

36import Data.Monoid(Monoid(..))

33import Data.Monoid(Monoid(..))

34+import Data.Semigroup

37import Database.PostgreSQL.Simple.FromField

35import Database.PostgreSQL.Simple.FromField

38import Database.PostgreSQL.Simple.ToField

36import Database.PostgreSQL.Simple.ToField

@@ -52,26 +50,28 @@ instance ToHStore HStoreBuilder where

52toBuilder :: HStoreBuilder -> Builder

50toBuilder :: HStoreBuilder -> Builder

53toBuilder x = case x of

51toBuilder x = case x of

54 Empty -> mempty

52 Empty -> mempty

55− Comma x -> x

53+ Comma c -> c

57toLazyByteString :: HStoreBuilder -> BL.ByteString

55toLazyByteString :: HStoreBuilder -> BL.ByteString

58toLazyByteString x = case x of

56toLazyByteString x = case x of

59 Empty -> BL.empty

57 Empty -> BL.empty

60− Comma x -> BU.toLazyByteString x

58+ Comma c -> BU.toLazyByteString c

62−instance Monoid HStoreBuilder where

60+instance Semigroup HStoreBuilder where

63− mempty = Empty

61+ Empty <> x = x

64− mappend Empty x = x

65− mappend (Comma a) x

62+ Comma a <> x

66 = Comma (a `mappend` case x of

63 = Comma (a `mappend` case x of

67 Empty -> mempty

64 Empty -> mempty

68 Comma b -> char8 ',' `mappend` b)

65 Comma b -> char8 ',' `mappend` b)

67+instance Monoid HStoreBuilder where

68+ mempty = Empty

69+

70class ToHStoreText a where

71 toHStoreText :: a -> HStoreText

73-- | Represents escape text, ready to be the key or value to a hstore value

74−newtype HStoreText = HStoreText Builder deriving (Typeable, Monoid)

74+newtype HStoreText = HStoreText Builder deriving (Typeable, Semigroup, Monoid)

76instance ToHStoreText HStoreText where

77 toHStoreText = id

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

144

145instance ToHStore HStoreMap where

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

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

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

148

149instance ToField HStoreMap where

150 toField xs = toField (toHStore xs)

src/Database/PostgreSQL/Simple/HStore/Internal.hs−2

@@ -1,5 +1,3 @@

1−{-# OPTIONS_HADDOCK hide #-}

2−

3------------------------------------------------------------------------------

1------------------------------------------------------------------------------

4-- |

2-- |

5-- Module: Database.PostgreSQL.Simple.HStore.Internal

3-- Module: Database.PostgreSQL.Simple.HStore.Internal

src/Database/PostgreSQL/Simple/Internal.hs+84−25

@@ -1,10 +1,13 @@

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

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

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

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

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

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

5-- |

8-- |

6-- Module: Database.PostgreSQL.Simple.Internal

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

8-- License: BSD3

11-- License: BSD3

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

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

10-- Stability: experimental

13-- Stability: experimental

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

33import qualified Data.IntMap as IntMap

36import qualified Data.IntMap as IntMap

34import Data.IORef

37import Data.IORef

35import Data.Maybe(fromMaybe)

38import Data.Maybe(fromMaybe)

36−import Data.Monoid

37import Data.String

39import Data.String

38import qualified Data.Text as T

40import qualified Data.Text as T

39import qualified Data.Text.Encoding as TE

41import qualified Data.Text.Encoding as TE

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

50import Control.Monad.Trans.State.Strict

52import Control.Monad.Trans.State.Strict

51import Control.Monad.Trans.Reader

53import Control.Monad.Trans.Reader

52import Control.Monad.Trans.Class

54import Control.Monad.Trans.Class

55+import GHC.Generics

53import GHC.IO.Exception

56import GHC.IO.Exception

54#if !defined(mingw32_HOST_OS)

57#if !defined(mingw32_HOST_OS)

55import Control.Concurrent(threadWaitRead, threadWaitWrite)

58import Control.Concurrent(threadWaitRead, threadWaitWrite)

@@ -80,18 +83,40 @@ data Connection = Connection {

80instance Eq Connection where

83instance Eq Connection where

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

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

86+-- | Superclass for postgresql exceptions

87+data SomePostgreSqlException = forall e. Exception e => SomePostgreSqlException e

88+ deriving Typeable

89+

90+postgresqlExceptionToException :: Exception e => e -> SomeException

91+postgresqlExceptionToException = toException . SomePostgreSqlException

92+

93+postgresqlExceptionFromException :: Exception e => SomeException -> Maybe e

94+postgresqlExceptionFromException x = do

95+ SomePostgreSqlException a <- fromException x

96+ cast a

97+

98+instance Show SomePostgreSqlException where

99+ showsPrec :: Int -> SomePostgreSqlException -> ShowS

100+ showsPrec p (SomePostgreSqlException e) = showsPrec p e

101+

102+instance Exception SomePostgreSqlException where

103+ displayException (SomePostgreSqlException e) = displayException e

104+

83data SqlError = SqlError {

105data SqlError = SqlError {

84 sqlState :: ByteString

106 sqlState :: ByteString

85 , sqlExecStatus :: ExecStatus

107 , sqlExecStatus :: ExecStatus

86 , sqlErrorMsg :: ByteString

108 , sqlErrorMsg :: ByteString

87 , sqlErrorDetail :: ByteString

109 , sqlErrorDetail :: ByteString

88 , sqlErrorHint :: ByteString

110 , sqlErrorHint :: ByteString

89− } deriving (Show, Typeable)

111+ } deriving (Eq, Show, Typeable)

112

91fatalError :: ByteString -> SqlError

113fatalError :: ByteString -> SqlError

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

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

115

94−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

120

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

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

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

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

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

100 , qeQuery :: Query

125 , qeQuery :: Query

101 } deriving (Eq, Show, Typeable)

126 } deriving (Eq, Show, Typeable)

102

127

103−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

104

131

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

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

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

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

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

111 , fmtParams :: [ByteString]

138 , fmtParams :: [ByteString]

112 } deriving (Eq, Show, Typeable)

139 } deriving (Eq, Show, Typeable)

113

140

114−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

115

144

116data ConnectInfo = ConnectInfo {

145data ConnectInfo = ConnectInfo {

117 connectHost :: String

146 connectHost :: String

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

119 , connectUser :: String

148 , connectUser :: String

120 , connectPassword :: String

149 , connectPassword :: String

121 , connectDatabase :: String

150 , connectDatabase :: String

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

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

123

152

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

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

125--

154--

@@ -153,10 +182,20 @@ defaultConnectInfo = ConnectInfo {

153connect :: ConnectInfo -> IO Connection

182connect :: ConnectInfo -> IO Connection

154connect = connectPostgreSQL . postgreSQLConnectionString

183connect = connectPostgreSQL . postgreSQLConnectionString

155

184

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

186+--

187+-- @since 0.6.5

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

189+withConnect connInfo = bracket (connect connInfo) close

190+

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

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

157−-- See <http://www.postgresql.org/docs/9.3/static/libpq-connect.html#LIBPQ-CONNSTRING>

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

158−-- for more information. Here is an example with some

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

194+-- parameters not provided, parameters provided as the empty string, and a

195+-- few other things; see

196+-- <https://www.postgresql.org/docs/9.5/static/libpq-envars.html>

159−-- of the most commonly used parameters:

197+-- for details. Here is an example with some of the most commonly used

198+-- parameters:

160--

199--

161-- > host='db.somedomain.com' port=5432 ...

200-- > host='db.somedomain.com' port=5432 ...

162--

201--

@@ -184,8 +223,9 @@ connect = connectPostgreSQL . postgreSQLConnectionString

184--

223--

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

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

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

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

187−-- not found. See

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

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

188−-- <http://www.postgresql.org/docs/9.3/static/libpq-pgpass.html> for

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

189-- more information regarding this file.

229-- more information regarding this file.

190--

230--

191-- As all parameters are optional and the defaults are sensible, the

231-- As all parameters are optional and the defaults are sensible, the

@@ -203,18 +243,20 @@ connect = connectPostgreSQL . postgreSQLConnectionString

203-- or production machines, or you will need to use a @pgpass@ file

243-- or production machines, or you will need to use a @pgpass@ file

204-- with the @password@ or @md5@ authentication methods.

244-- with the @password@ or @md5@ authentication methods.

205--

245--

206−-- See <http://www.postgresql.org/docs/9.3/static/client-authentication.html>

246+-- See <https://www.postgresql.org/docs/9.5/static/client-authentication.html>

207-- for more information regarding the authentication process.

247-- for more information regarding the authentication process.

208--

248--

209-- SSL/TLS will typically "just work" if your postgresql server supports or

249-- SSL/TLS will typically "just work" if your postgresql server supports or

210-- requires it. However, note that libpq is trivially vulnerable to a MITM

250-- requires it. However, note that libpq is trivially vulnerable to a MITM

211−-- attack without setting additional SSL parameters in the connection string.

251+-- attack without setting additional SSL connection parameters. In

212−-- In particular, @sslmode@ needs to be set to @require@, @verify-ca@, or

252+-- particular, @sslmode@ needs to be set to @require@, @verify-ca@, or

213-- @verify-full@ in order to perform certificate validation. When @sslmode@

253-- @verify-full@ in order to perform certificate validation. When @sslmode@

214-- is @require@, then you will also need to specify a @sslrootcert@ file,

254-- is @require@, then you will also need to specify a @sslrootcert@ file,

215-- otherwise no validation of the server's identity will be performed.

255-- otherwise no validation of the server's identity will be performed.

216-- Client authentication via certificates is also possible via the

256-- Client authentication via certificates is also possible via the

217−-- @sslcert@ and @sslkey@ parameters.

257+-- @sslcert@ and @sslkey@ parameters. See

258+-- <https://www.postgresql.org/docs/9.5/static/libpq-ssl.html>

259+-- for detailed information regarding libpq and SSL.

218

260

219connectPostgreSQL :: ByteString -> IO Connection

261connectPostgreSQL :: ByteString -> IO Connection

220connectPostgreSQL connstr = do

262connectPostgreSQL connstr = do

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

281

323

282 str name field

324 str name field

283 | null value = id

325 | null value = id

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

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

285 where value = field connectInfo

327 where value = field connectInfo

286

328

287 num name field

329 num name field

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

289 | otherwise = showString name . shows value . space

331 | otherwise = showString name . shows value . space

290 where value = field connectInfo

332 where value = field connectInfo

291

333

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

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

293 where

335 where

294 delta c cs = case c of

336 delta c cs = case c of

295 '\\' -> '\\' : '\\' : cs

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

@@ -345,6 +387,7 @@ exec conn sql =

345 Just res -> do

387 Just res -> do

346 status <- PQ.resultStatus res

388 status <- PQ.resultStatus res

347 case status of

389 case status of

390+ -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple

348 PQ.EmptyQuery -> getResult h mres'

391 PQ.EmptyQuery -> getResult h mres'

349 PQ.CommandOk -> getResult h mres'

392 PQ.CommandOk -> getResult h mres'

350 PQ.TuplesOk -> getResult h mres'

393 PQ.TuplesOk -> getResult h mres'

@@ -365,6 +408,7 @@ finishExecute :: Connection -> Query -> PQ.Result -> IO Int64

365finishExecute _conn q result = do

408finishExecute _conn q result = do

366 status <- PQ.resultStatus result

409 status <- PQ.resultStatus result

367 case status of

410 case status of

411+ -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple

368 PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q

412 PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q

369 PQ.CommandOk -> do

413 PQ.CommandOk -> do

370 ncols <- PQ.nfields result

414 ncols <- PQ.nfields result

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

375 nstr <- PQ.cmdTuples result

419 nstr <- PQ.cmdTuples result

376 return $ case nstr of

420 return $ case nstr of

377 Nothing -> 0 -- is this appropriate?

421 Nothing -> 0 -- is this appropriate?

378− Just str -> toInteger str

422+ Just str -> mkInteger str

379 PQ.TuplesOk -> do

423 PQ.TuplesOk -> do

380 ncols <- PQ.nfields result

424 ncols <- PQ.nfields result

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

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

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

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

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

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

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

390 where

434 where

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

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

392 where

436 where

393 delta acc c =

437 delta acc c =

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

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

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

403 PQ.resultErrorField result PQ.DiagMessageDetail

447 PQ.resultErrorField result PQ.DiagMessageDetail

404 hint <- fromMaybe "" <$>

448 hint <- fromMaybe "" <$>

405 PQ.resultErrorField result PQ.DiagMessageHint

449 PQ.resultErrorField result PQ.DiagMessageHint

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

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

407− throwIO $ SqlError { sqlState = state

451+ throwIO $ SqlError { sqlState = state'

408 , sqlExecStatus = status

452 , sqlExecStatus = status

409 , sqlErrorMsg = errormsg

453 , sqlErrorMsg = errormsg

410 , sqlErrorDetail = detail

454 , sqlErrorDetail = detail

@@ -473,7 +517,6 @@ instance Alternative Conversion where

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

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

474

518

475instance Monad Conversion where

519instance Monad Conversion where

476− return a = Conversion $ \_conn -> return (return a)

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

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

478 oka <- runConversion m conn

521 oka <- runConversion m conn

479 case oka of

522 case oka of

@@ -488,7 +531,7 @@ conversionMap :: (Ok a -> Ok b) -> Conversion a -> Conversion b

488conversionMap f m = Conversion $ \conn -> f <$> runConversion m conn

531conversionMap f m = Conversion $ \conn -> f <$> runConversion m conn

489

532

490conversionError :: Exception err => err -> Conversion a

533conversionError :: Exception err => err -> Conversion a

491−conversionError err = Conversion $ \_ -> return (Errors [SomeException err])

534+conversionError err = Conversion $ \_ -> return (Errors [toException err])

492

535

493newTempName :: Connection -> IO Query

536newTempName :: Connection -> IO Query

494newTempName Connection{..} = do

537newTempName Connection{..} = do

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

576

619

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

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

578escapeByteaConn = escapeWrap PQ.escapeByteaConn

621escapeByteaConn = escapeWrap PQ.escapeByteaConn

622+

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

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

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

626+ -- seperate from first QM

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

628+ -- if end of query, just return

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

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

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

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

633+ -- another QM after the first means:

634+ -- take literal QM and keep going.

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

636+ -- Anything else means

637+ go2 _ = tup

src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hsnew file+123

@@ -0,0 +1,123 @@

1+{-# LANGUAGE CPP #-}

3+------------------------------------------------------------------------------

4+-- |

5+-- Module: Database.PostgreSQL.Simple.Internal.PQResultUtils

8+-- License: BSD3

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

10+-- Stability: experimental

11+--

12+------------------------------------------------------------------------------

13+

14+

15+module Database.PostgreSQL.Simple.Internal.PQResultUtils

16+ ( finishQueryWith

17+ , finishQueryWithV

18+ , finishQueryWithVU

19+ , getRowWith

20+ ) where

21+

22+import Control.Exception as E

23+import Data.ByteString (ByteString)

24+import Data.Foldable (for_)

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

26+import Database.PostgreSQL.Simple.Ok

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

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

29+import Database.PostgreSQL.Simple.TypeInfo

30+import qualified Database.PostgreSQL.LibPQ as PQ

31+import qualified Data.ByteString.Char8 as B

32+import qualified Data.Vector as V

33+import qualified Data.Vector.Mutable as MV

34+import qualified Data.Vector.Unboxed as VU

35+import qualified Data.Vector.Unboxed.Mutable as MVU

36+import Control.Monad.Trans.Reader

37+import Control.Monad.Trans.State.Strict

38+

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

40+finishQueryWith parser conn q result = finishQueryWith' q result $ do

41+ nrows <- PQ.ntuples result

42+ ncols <- PQ.nfields result

43+ forM' 0 (nrows-1) $ \row ->

44+ getRowWith parser row ncols conn result

45+

46+finishQueryWithV :: RowParser r -> Connection -> Query -> PQ.Result -> IO (V.Vector r)

47+finishQueryWithV parser conn q result = finishQueryWith' q result $ do

48+ nrows <- PQ.ntuples result

49+ let PQ.Row nrows' = nrows

50+ ncols <- PQ.nfields result

51+ mv <- MV.unsafeNew (fromIntegral nrows')

52+ for_ [ 0 .. nrows-1 ] $ \row -> do

53+ let PQ.Row row' = row

54+ value <- getRowWith parser row ncols conn result

55+ MV.unsafeWrite mv (fromIntegral row') value

56+ V.unsafeFreeze mv

57+

58+finishQueryWithVU :: VU.Unbox r => RowParser r -> Connection -> Query -> PQ.Result -> IO (VU.Vector r)

59+finishQueryWithVU parser conn q result = finishQueryWith' q result $ do

60+ nrows <- PQ.ntuples result

61+ let PQ.Row nrows' = nrows

62+ ncols <- PQ.nfields result

63+ mv <- MVU.unsafeNew (fromIntegral nrows')

64+ for_ [ 0 .. nrows-1 ] $ \row -> do

65+ let PQ.Row row' = row

66+ value <- getRowWith parser row ncols conn result

67+ MVU.unsafeWrite mv (fromIntegral row') value

68+ VU.unsafeFreeze mv

69+

70+finishQueryWith' :: Query -> PQ.Result -> IO a -> IO a

71+finishQueryWith' q result k = do

72+ status <- PQ.resultStatus result

73+ case status of

74+ PQ.TuplesOk -> k

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

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

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

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

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

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

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

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

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

84+ where

85+ queryErr msg = throwIO $ QueryError msg q

86+

87+getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> PQ.Result -> IO r

88+getRowWith parser row ncols conn result = do

89+ let rw = Row row result

90+ let unCol (PQ.Col x) = fromIntegral x :: Int

91+ okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn

92+ case okvc of

93+ Ok (val,col) | col == ncols -> return val

94+ | otherwise -> do

95+ vals <- forM' 0 (ncols-1) $ \c -> do

96+ tinfo <- getTypeInfo conn =<< PQ.ftype result c

97+ v <- PQ.getvalue result row c

98+ return ( tinfo

99+ , fmap ellipsis v )

100+ throw (ConversionFailed

101+ (show (unCol ncols) ++ " values: " ++ show vals)

102+ Nothing

103+ ""

104+ (show (unCol col) ++ " slots in target type")

105+ "mismatch between number of columns to convert and number in target type")

106+ Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"

107+ Errors [x] -> throwIO x

108+ Errors xs -> throwIO $ ManyErrors xs

109+

110+ellipsis :: ByteString -> ByteString

111+ellipsis bs

112+ | B.length bs > 15 = B.take 10 bs `B.append` "[...]"

113+ | otherwise = bs

114+

115+forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]

116+forM' lo hi m = loop hi []

117+ where

118+ loop !n !as

119+ | n < lo = return as

120+ | otherwise = do

121+ a <- m n

122+ loop (n-1) (a:as)

123+{-# INLINE forM' #-}

src/Database/PostgreSQL/Simple/LargeObjects.hs+1−1

@@ -7,7 +7,7 @@

7-- Maintainer : leon@melding-monads.com

8--

9-- Support for PostgreSQL's Large Objects; see

10−-- <http://www.postgresql.org/docs/9.1/static/largeobjects.html> for more

10+-- <https://www.postgresql.org/docs/9.5/static/largeobjects.html> for more

11-- information.

12--

13-- Note that Large Object File Descriptors are only valid within a single

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

@@ -5,7 +5,8 @@

5-----------------------------------------------------------------------------

6-- |

7-- Module : Database.PostgreSQL.Simple.Notification

9-- License : BSD3

10-- License : BSD3

10--

11--

11-- Maintainer : leon@melding-monads.com

12-- Maintainer : leon@melding-monads.com

@@ -13,7 +14,7 @@

13--

14--

14-- Support for receiving asynchronous notifications via PostgreSQL's

15-- Support for receiving asynchronous notifications via PostgreSQL's

15-- Listen/Notify mechanism. See

16-- Listen/Notify mechanism. See

16−-- <http://www.postgresql.org/docs/9.1/static/sql-notify.html> for more

17+-- <https://www.postgresql.org/docs/9.5/static/sql-notify.html> for more

17-- information.

18-- information.

18--

19--

19-- Note that on Windows, @getNotification@ currently uses a polling loop

20-- Note that on Windows, @getNotification@ currently uses a polling loop

@@ -24,7 +25,7 @@

24-- Notifications do not create any extra work for the backend, and are

25-- Notifications do not create any extra work for the backend, and are

25-- likely cheaper on the client side as well.

26-- likely cheaper on the client side as well.

26--

27--

27−-- <http://hackage.haskell.org/trac/ghc/ticket/7353>

28+-- <https://hackage.haskell.org/trac/ghc/ticket/7353>

28--

29--

29-----------------------------------------------------------------------------

30-----------------------------------------------------------------------------

@@ -35,19 +36,27 @@ module Database.PostgreSQL.Simple.Notification

35 , getBackendPID

36 , getBackendPID

36 ) where

37 ) where

38−import Control.Concurrent

39+import Control.Monad ( join, void )

39−import Control.Monad ( when )

40−import Control.Exception ( throwIO )

40+import Control.Exception ( throwIO, catch )

41import qualified Data.ByteString as B

42+import qualified Data.ByteString.Char8 as B8

42import Database.PostgreSQL.Simple.Internal

43import Database.PostgreSQL.Simple.Internal

43import qualified Database.PostgreSQL.LibPQ as PQ

44import qualified Database.PostgreSQL.LibPQ as PQ

44import System.Posix.Types ( CPid )

45import System.Posix.Types ( CPid )

46+import GHC.IO.Exception ( ioe_location )

47+

48+#if defined(mingw32_HOST_OS)

49+import Control.Concurrent ( threadDelay )

50+#else

51+import GHC.Conc ( atomically )

52+import Control.Concurrent ( threadWaitReadSTM )

53+#endif

46data Notification = Notification

55data Notification = Notification

47− { notificationPid :: !CPid

56+ { notificationPid :: {-# UNPACK #-} !CPid

48− , notificationChannel :: !B.ByteString

57+ , notificationChannel :: {-# UNPACK #-} !B.ByteString

49− , notificationData :: !B.ByteString

58+ , notificationData :: {-# UNPACK #-} !B.ByteString

50− }

59+ } deriving (Show, Eq)

52convertNotice :: PQ.Notify -> Notification

61convertNotice :: PQ.Notify -> Notification

53convertNotice PQ.Notify{..}

62convertNotice PQ.Notify{..}

@@ -57,35 +66,56 @@ convertNotice PQ.Notify{..}

58-- | Returns a single notification. If no notifications are available,

67-- | Returns a single notification. If no notifications are available,

59-- 'getNotification' blocks until one arrives.

68-- 'getNotification' blocks until one arrives.

69+--

70+-- It is safe to call 'getNotification' on a connection that is concurrently

71+-- being used for other purposes, note however that PostgreSQL does not

72+-- deliver notifications while a connection is inside a transaction.

61getNotification :: Connection -> IO Notification

74getNotification :: Connection -> IO Notification

62−getNotification conn = loop False

75+getNotification conn = join $ withConnection conn fetch

63 where

76 where

64 funcName = "Database.PostgreSQL.Simple.Notification.getNotification"

77 funcName = "Database.PostgreSQL.Simple.Notification.getNotification"

65− loop doConsume = do

78+

66− res <- withConnection conn $ \c -> do

79+ fetch c = do

67− when doConsume (PQ.consumeInput c >> return ())

68− mmsg <- PQ.notifies c

80+ mmsg <- PQ.notifies c

69− case mmsg of

81+ case mmsg of

82+ Just msg -> return (return $! convertNotice msg)

70− Nothing -> do

83+ Nothing -> do

71− mfd <- PQ.socket c

84+ mfd <- PQ.socket c

72− case mfd of

85+ case mfd of

73− Nothing -> throwIO $ fdError funcName

86+ Nothing -> return (throwIO $! fdError funcName)

74− Just fd -> return (Left fd)

75− Just msg -> return (Right msg)

76− -- FIXME? what happens if the connection is closed/reset right here?

77− case res of

78#if defined(mingw32_HOST_OS)

87#if defined(mingw32_HOST_OS)

79− -- threadWaitRead doesn't work for sockets on Windows, so just poll

88+ -- threadWaitRead doesn't work for sockets on Windows, so just

80− -- for input every second (PQconsumeInput is non-blocking).

89+ -- poll for input every second (PQconsumeInput is non-blocking).

81− --

90+ --

82− -- We could call select(), but FFI calls can't be interrupted with

91+ -- We could call select(), but FFI calls can't be interrupted

83− -- async exceptions, whereas threadDelay can.

92+ -- with async exceptions, whereas threadDelay can.

93+ Just _fd -> do

84− Left _fd -> threadDelay 1000000 >> loop True

94+ return (threadDelay 1000000 >> loop)

85#else

95#else

86− Left fd -> threadWaitRead fd >> loop True

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

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

98+ -- there is no opportunity for the descriptor index to be

99+ -- reallocated on us.

100+ --

101+ -- (That is, assuming there isn't concurrently executing

102+ -- code that manipulates the descriptor without holding

103+ -- the lock... but such a major bug is likely to exhibit

104+ -- itself in an at least somewhat more dramatic fashion.)

105+ Just fd -> do

106+ (waitRead, _) <- threadWaitReadSTM fd

107+ return $ do

108+ atomically waitRead `catch` (throwIO . setIOErrorLocation)

109+ loop

87#endif

110#endif

88− Right msg -> return $! convertNotice msg

111+

112+ loop = join $ withConnection conn $ \c -> do

113+ void $ PQ.consumeInput c

114+ fetch c

115+

116+ setIOErrorLocation :: IOError -> IOError

117+ setIOErrorLocation err = err { ioe_location = B8.unpack funcName }

118+

119

90-- | Non-blocking variant of 'getNotification'. Returns a single notification,

120-- | Non-blocking variant of 'getNotification'. Returns a single notification,

91-- if available. If no notifications are available, returns 'Nothing'.

121-- if available. If no notifications are available, returns 'Nothing'.

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

@@ -1,10 +1,11 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveFunctor #-}

3+{-# LANGUAGE CPP #-}

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

5------------------------------------------------------------------------------

5-- |

6-- |

6-- Module : Database.PostgreSQL.Simple.Ok

7-- Module : Database.PostgreSQL.Simple.Ok

8-- License : BSD3

9-- License : BSD3

9--

10--

10-- Maintainer : leon@melding-monads.com

11-- Maintainer : leon@melding-monads.com

@@ -20,7 +21,7 @@

20-- commonly-used type and typeclass included in @base@.

21-- commonly-used type and typeclass included in @base@.

21--

22--

22-- Extending the failure case to a list of 'SomeException's enables a

23-- Extending the failure case to a list of 'SomeException's enables a

23−-- more sensible 'Alternative' instance definitions: '<|>' concatinates

24+-- more sensible 'Alternative' instance definitions: '<|>' concatenates

24-- the list of exceptions when both cases fail, and 'empty' is defined as

25-- the list of exceptions when both cases fail, and 'empty' is defined as

25-- 'Errors []'. Though '<|>' one could pick one of two exceptions, and

26-- 'Errors []'. Though '<|>' one could pick one of two exceptions, and

26-- throw away the other, and have 'empty' provide a generic exception,

27-- throw away the other, and have 'empty' provide a generic exception,

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

36import Control.Monad(MonadPlus(..))

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

37import Data.Typeable

38import Data.Typeable

40+import qualified Control.Monad.Fail as Fail

41+

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

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

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

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

@@ -69,11 +72,14 @@ instance MonadPlus Ok where

69 mplus = (<|>)

72 mplus = (<|>)

71instance Monad Ok where

74instance Monad Ok where

72− return = Ok

73−

74 Errors es >>= _ = Errors es

75 Errors es >>= _ = Errors es

75 Ok a >>= f = f a

76 Ok a >>= f = f a

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

79+ fail = Fail.fail

80+#endif

81+

82+instance Fail.MonadFail Ok where

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

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

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

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

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

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

19 , empty

20 , isEmpty, isEmptyBy

21 , contains, containsBy

22+ , fromFieldRange

22 ) where

23 ) where

24import Control.Applicative hiding (empty)

25import Control.Applicative hiding (empty)

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

37import Data.Scientific (Scientific)

38import Data.Scientific (Scientific)

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

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

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

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

40−import Data.Time (Day, LocalTime,

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

41 NominalDiffTime,

42 NominalDiffTime,

42 TimeOfDay, UTCTime,

43 TimeOfDay, UTCTime,

43 ZonedTime,

44 ZonedTime,

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

109 PGRange _lb NegInfinity -> False

110 PGRange _lb NegInfinity -> False

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

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

111 where

112 where

112− checkLB lb x =

113+ checkLB lb y =

113 case lb of

114 case lb of

114 NegInfinity -> True

115 NegInfinity -> True

115 PosInfinity -> False

116 PosInfinity -> False

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

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

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

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

118

119

119− checkUB ub x =

120+ checkUB ub y =

120 case ub of

121 case ub of

121 NegInfinity -> False

122 NegInfinity -> False

122 PosInfinity -> True

123 PosInfinity -> True

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

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

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

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

125

126

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

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

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

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

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

189

190

191

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

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

192− fromField f mdat = do

193+ fromField = fromFieldRange fromField

194+

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

196+fromFieldRange fromField' f mdat = do

193 info <- typeInfo f

197 info <- typeInfo f

194 case info of

198 case info of

195 Range{} ->

199 Range{} ->

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

199 Just "empty" -> pure $ empty

203 Just "empty" -> pure $ empty

200 Just bs ->

204 Just bs ->

201 let parseIt NegInfinity = pure NegInfinity

205 let parseIt NegInfinity = pure NegInfinity

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

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

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

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

204 parseIt PosInfinity = pure PosInfinity

208 parseIt PosInfinity = pure PosInfinity

205 in case parseOnly pgrange bs of

209 in case parseOnly pgrange bs of

206 Left e -> returnError ConversionFailed f e

210 Left e -> returnError ConversionFailed f e

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

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

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

1{-# LANGUAGE TemplateHaskell #-}

5{-# LANGUAGE TemplateHaskell #-}

6+#endif

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

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

3-- |

8-- |

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

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

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

30-- > (beginTime,endTime,string)

35-- > (beginTime,endTime,string)

31--

36--

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

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

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

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

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

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

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

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

36--

41--

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

53sql :: QuasiQuoter

58sql :: QuasiQuoter

54sql = QuasiQuoter

59sql = QuasiQuoter

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

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

56− \ quasiquoter used in pattern context"

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

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

58− \ quasiquoter used in type context"

59 , quoteExp = sqlExp

62 , quoteExp = sqlExp

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

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

61− \ quasiquoter used in declaration context"

62 }

64 }

64sqlExp :: String -> Q Exp

66sqlExp :: String -> Q Exp

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

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

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

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

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

87 instring (x:xs) = x : instring xs

89 instring (x:xs) = x : instring xs

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

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

89− \ string literal not terminated"

src/Database/PostgreSQL/Simple/Time.hs+215−50

@@ -1,53 +1,216 @@

1−------------------------------------------------------------------------------

1+{- |

2−-- |

3−-- Module: Database.PostgreSQL.Simple.Time

2+Module: Database.PostgreSQL.Simple.Time

5−-- License: BSD3

4+License: BSD3

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

5+Maintainer: Leon P Smith <leon@melding-monads.com>

7−-- Stability: experimental

6+Stability: experimental

8−--

9−-- Time types that supports positive and negative infinity. Also includes

8+This module provides time types that supports positive and negative

10−-- new time parsers and printers with better performance than GHC's time

9+infinity, as well as some functions for converting to and from strings.

11−-- package.

10+

12−--

11+Also, this module also contains commentary regarding postgresql's timestamp

13−-- The parsers only understand the specific variant of ISO 8601 that

12+types, civil timekeeping in general, and how it relates to

14−-- PostgreSQL emits, and the printers attempt to duplicate this syntax.

13+postgresql-simple. You can read more about PostgreSQL's date and time types

15−-- Thus the @datestyle@ parameter for the connection must be set to @ISO@.

14+at <https://www.postgresql.org/docs/9.5/static/datatype-datetime.html>,

16−--

15+and the IANA time zone database at <https://en.wikipedia.org/wiki/Tz_database>.

17−-- These parsers and printers likely have problems and shortcomings. Some

16+

18−-- that I know of:

17+Stack Overflow also has some excellent commentary on time, if it is a

19−--

18+wiki page or a highly upvoted question and answer. If the answer regarding

20−-- 1 @TimestampTZ@s before a timezone-dependent point in time cannot be

19+time has not received about a hundred upvotes at least, then the answer is

21−-- parsed, because the parsers can only handle timezone offsets of a

20+almost invariably completely and painfully wrong, even if it's the chosen

22−-- integer number of minutes. However, PostgreSQL will include seconds

21+answer or the most highly upvoted answer to a question.

23−-- in the offset, depending on the historical time standards for the city

22+

24−-- identifying the time zone.

23+PostgreSQL's @timestamp with time zone@ (hereafter, @timestamptz@) can be

25−--

24+converted to Haskell's 'Data.Time.UTCTime' and 'Data.Time.ZonedTime' types,

26−-- This boundary point often marks an event of some interest. In the US

25+because values of these types represent a self-contained, unambiguous point

27−-- for example, @timestamptz@s before @1883-Nov-18 12:00:00@ local time

26+in time. PostgreSQL's @timestamp without time zone@ (hereafter, @timestamp@)

28−-- cannot be parsed. This is the moment Standard Railway Time went live.

27+can be converted to Haskell's 'Data.Time.LocalTime', because values of these

28+types are ambiguous by themselves, and require context to disambiguate.

29+

30+While this behavior may be superficially counterintuitive because the

31+names might suggest otherwise, this behavior is correct. In fact,

32+the \"timezone\" language in both the postgresql and haskell types would

33+be better read as \"offset (from UTC)\", thus we have postgresql's

34+\"timestamp with offset\" corresponding to Haskell's \"time with the

35+offset \'zero\'\" and Haskell's \"time with an offset (that might be

36+nonzero)\". Similarly, postgresql's \"timestamp without an offset\"

37+corresponds to Haskell's \"local time (without an offset)\".

38+

39+It's important to distinguish between an offset, a standard time, and

40+a time zone. An offset is simply a difference of a local time from UTC,

41+such as @+00@, @-05@, or @+05:30@. A standard time specifies an offset

42+(which may vary throughout the year, due to daylight savings) that a

43+region follows, such as Universal Coordinated Time (UTC), Eastern Standard

44+Time\/Eastern Daylight Time (EST\/EDT), or India Standard Time (IST).

45+And a time zone, much like a standard time, is a function from

46+timestamps to offsets.

47+

48+A time zone is different from a standard time because different regions

49+inside a standard time can be governed by different civil authorities with

50+different laws and thus have different histories of civil time. An IANA

51+time zone is any region of the world that has had the same history of

52+civil time since @1970-01-01 00:00+00@.

53+

54+For example, as of today, both @America\/New_York@ and

55+@America\/Indiana\/Indianapolis@ are on the EST\/EDT time standard, but

56+Indiana used to be on Central Standard Time until 1942, and did not observe

57+daylight savings time (EST only) until 2006. Thus, the choice between

58+these two time zones still matters if you are dealing with timestamps

59+prior to 2006, and could become relevant again if (most of) Indiana

60+moves back to Central Time. (Of course, if the Central to Eastern switch

61+was the only difference, then these two time zones would be the same in

62+IANA's eyes, due to their cutoff date of 1970-01-01.)

63+

64+Getting back to practicalities, PostgreSQL's @timestamptz@ type does not

65+actually store an offset; rather, it uses the offset provided to calculate

66+UTC, and stores the timestamp as UTC. If an offset is not provided, the

67+given timestamp is assumed to be a local time for whatever the @timezone@

68+variable is set to, and the IANA TZ database is consulted to calculate an

69+offset from UTC for the time in question.

70+

71+Note that while most (local timestamp, time zone) pairs correspond to exactly

72+one UTC timestamp, some correspond to two UTC timestamps, while others

73+correspond to none at all. The ambiguous case occurs when the civil time

74+is rolled back, making a calendar day longer than 24 hours. In this case,

75+PostgreSQL silently chooses the second, later possibility. The inconsistent

76+case occurs when the civil time is moved forward, making a calendar day less

77+than 24 hours. In this case, PostgreSQL silently assumes the local time

78+was read off a clock that had not been moved forward at the prescribed time,

79+and moves the clock forward for you. Thus, converting from local time

80+to UTC need not be monotonic, if these inconsistent cases are allowed.

81+

82+When retrieving a @timestamptz@, the backend looks at the @time zone@

83+connection variable and then consults the IANA TZ database to calculate

84+an offset for the timestamp in the given time zone.

85+

86+Note that while some of the information contained in the IANA TZ database

87+is a bit of a standardized fiction, the conversion from UTC time to a

88+(local time, offset) pair in a particular time zone is always unambiguous,

89+and the result can always be unambiguously converted back to UTC. Thus,

90+postgresql-simple can interpret such a result as a 'Data.Time.ZonedTime',

91+or use the offset to convert back to 'Data.Time.UTCTime'.

92+

93+By contrast, the @timestamp@ type ignores any offsets provided to it,

94+and never sends back an offset. Thus, postgresql-simple equates this

95+with 'Data.Time.LocalTime', which has no concept of an offset. One can

96+convert between @timestamptz@ and @timestamp@ using the @AT TIME ZONE@

97+operator, whose semantics also demonstrates that @timestamptz@ is

98+'Data.Time.UTCTime' whereas @timestamp@ is 'Data.Time.LocalTime'.

99+

100+PostgreSQL's @timezone@ is a per-connection variable that by default is

101+initialized to @\'localtime\'@, which normally corresponds to the server's

102+time zone. However, this default can be modified on the server side for an

103+entire cluster, or on a per-user or per-database basis. Moreover, a client

104+can modify their instance of the variable at any time, and can apply that

105+change to the remaining duration of the connection, the current transaction,

106+or the execution context of a server-side function. In addition, upon

107+connection initialization, the libpq client checks for the existence of

108+the @PGTZ@ environment variable, and if it exists, modifies @timezone@

109+accordingly.

110+

111+With a few caveats, postgresql-simple is designed so that you can both send

112+and receive timestamps with the server and get a correct result, no matter

113+what the @timezone@ setting is. But it is important to understand the caveats:

114+

115+1. The correctness of server-side computations can depend on the @timezone@

116+ setting. Examples include adding an @interval@ to a @timestamptz@, or

117+ type casting between @timestamp@ and @timestamptz@, or applying

118+ the @DATE@ function to a @timestamptz@.

119+

120+2. The (localtime, offset) pair contained in a 'Data.Time.ZonedTime' result

121+ will depend on the @timezone@ setting, although the result will always

122+ represent the same instant in time regardless of the time zone.

123+

124+3. Sending a 'Data.Time.LocalTime' and interpreting it as a @timestamptz@

125+ can be useful, as it will be converted to UTC via the tz database,

126+ but correctness will depend on the @timezone@ setting. You may prefer

127+ to use an explicit @AT TIME ZONE@ conversion instead, which would avoid

128+ this contextual dependence.

129+

130+Furthermore, although these following points don't involve the @timezone@

131+setting, they are related to the last point above:

132+

133+1. Sending a 'Data.Time.UTCTime' and interpreting it as a @timestamp@ can

134+ be useful. In practice, the most common context used to disambiguate

135+ @timestamp@ is that it represents UTC, and this coding technique will

136+ work as expected in this situation.

137+

138+2. Sending a 'Data.Time.ZonedTime' and interpreting it as a @timestamp@ is

139+ almost always the wrong thing to do, as the offset will be ignored and

140+ discarded. This is likely to lead to inconsistencies in the database,

141+ and may lead to partial data loss.

142+

143+When dealing with local timestamps that refer to the future, it is often

144+useful to store it as a local time in a @timestamp@ column and store the

145+time zone in a second column. One reason to do this is so that you can

146+convert to UTC on the fly as needed, and be protected against future changes

147+to the TZ database due to changes in local time standards. In any case,

148+'Data.Time.ZonedTime' is not suitable for this application, because despite

149+its name, it represents an offset and not a time zone. Time zones can change;

150+offsets do not. In reality, we can't convert a local timestamp that occurs

151+sufficiently far in the future to UTC, because we don't know how to do it yet.

152+

153+There are a few limitations and caveats that one might need to be aware

154+of with the current implementation when dealing with older timestamps:

155+

156+For sufficiently old timestamps in almost all time zones, the IANA TZ

157+database specifies offsets from UTC that is not an integral number of

158+minutes. This corresponds to local mean time; that is, astronomical

159+time in the city that defines the time zone. Different time zones moved

160+away from local mean time to a standard time at different points in

161+history, so \"sufficiently old\" depends on the time zone in question.

162+

163+Thus, when retrieving a @timestamptz@ postgresql will in some cases

164+provide seconds in the offset. For example:

165+

166+@

167+$ psql

168+psql (9.4.5)

169+Type \"help\" for help.

170+

171+lpsmith=> SET timezone TO \'America/New_York\';

172+SET

173+lpsmith=> VALUES (\'1883-11-18 16:59:59+00\'::timestamptz),

174+ (\'1883-11-18 17:00:00+00\'::timestamptz);

175+ column1

176+------------------------------

29−-- Concretely, PostgreSQL will emit @1883-11-18 12:03:57-04:56:02@

177+ 1883-11-18 12:03:57-04:56:02

30−-- instead of @1883-11-18 11:59:59-05@ when the @timezone@ parameter

178+ 1883-11-18 12:00:00-05

31−-- for the connection is set to @America/New_York@.

179+(2 rows)

32−--

180+@

33−-- 2. Dates and times surrounding @1582-Feb-24@, the date the Gregorian

181+

34−-- Calendar was introduced, should be investigated for conversion errors.

182+Both of these timestamps can be parsed as a 'Data.Time.UTCTime' type,

35−--

183+however 'Data.Time.ZonedTime' will fail on the former timestamp.

184+Because 'Data.Time.ZonedTime' assumes that offsets are an integer number

185+of minutes, there isn't an particularly good solution here.

186+

187+PostgreSQL, like most software, uses the proleptic Gregorian calendar

188+for its date calculations, extending the Gregorian calendar backwards

189+in time before its introduction and pretending that the Julian calendar

190+does not exist. For most purposes, the adoption of the Gregorian calendar

191+ranges from @1582-10-15@ to @1923-03-01@, depending on location and

192+sometimes even political allegiances within a single location.

193+

36−-- 3. Points in time Before Christ are not also not supported. For example,

194+Timestamps BCE are not supported. For example, PostgreSQL

37−-- PostgreSQL will emit @0045-01-01 BC@ for a value of a @date@ type.

195+will emit \"@0045-01-01 BC@\" for the first proleptic Gregorian day of

38−-- This is the year that the Julian Calendar was adopted.

196+the year the Roman Empire adopted the Julian Calendar, but

39−--

197+postgresql-simple does not (yet?) have the ability to either parse or

40−-- However, it should be noted that the old parsers also had issues 1 and 3.

198+generate this syntax. Unfortunately this syntax isn't convenient to

41−-- Also, the new parsers now correctly handle time zones that include minutes

199+print or especially parse.

42−-- in their offset. Most notably, this includes all of India and parts of

200+

43−-- Canada and Australia.

201+Also, postgresql itself cannot parse or print dates before @4714-11-24 BC@,

44−--

202+which is the Julian date on the proleptic Gregorian Calendar. Although

45−-- PostgreSQL uses the zoneinfo database for its time zone information.

203+postgresql's timestamp types are perfectly capable of representing timestamps

46−-- You can read more about PostgreSQL's date and time types at

204+nearly 300,000 years in the past, using this would require postgresql-simple

47−-- <http://www.postgresql.org/docs/9.1/static/datatype-datetime.html>,

205+and other client programs to support binary parameters and results.

48−-- and zoneinfo at <http://en.wikipedia.org/wiki/Tz_database>.

206+

49−--

207+Dealing with years BCE is also complicated slightly by the fact that

50−------------------------------------------------------------------------------

208+Haskell's time library has a year \"0000\", which is a convention often

209+used by astronomers, while postgresql adopts the more historically

210+accurate convention that there is no year zero, but rather \"1 BCE\"

211+was immediately followed by \"1 CE\".

212+

213+-}

214

52module Database.PostgreSQL.Simple.Time

215module Database.PostgreSQL.Simple.Time

53 ( Unbounded(..)

216 ( Unbounded(..)

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

64 , parseUTCTimestamp

227 , parseUTCTimestamp

65 , parseZonedTimestamp

228 , parseZonedTimestamp

66 , parseLocalTimestamp

229 , parseLocalTimestamp

230+ , parseCalendarDiffTime

67 , dayToBuilder

231 , dayToBuilder

68 , utcTimeToBuilder

232 , utcTimeToBuilder

69 , zonedTimeToBuilder

233 , zonedTimeToBuilder

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

76 , localTimestampToBuilder

240 , localTimestampToBuilder

77 , unboundedToBuilder

241 , unboundedToBuilder

78 , nominalDiffTimeToBuilder

242 , nominalDiffTimeToBuilder

243+ , calendarDiffTimeToBuilder

79 ) where

244 ) where

245

81import Database.PostgreSQL.Simple.Time.Implementation

246import Database.PostgreSQL.Simple.Time.Implementation

src/Database/PostgreSQL/Simple/Time/Implementation.hs+23−108

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

1------------------------------------------------------------------------------

2-- |

3-- Module: Database.PostgreSQL.Simple.Time.Implementation

5-- License: BSD3

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

7-- Stability: experimental

@@ -13,23 +13,19 @@

13module Database.PostgreSQL.Simple.Time.Implementation where

15import Prelude hiding (take)

16−import Data.ByteString.Builder(Builder, byteString, char8, integerDec)

16+import Data.ByteString.Builder(Builder, byteString)

17+import Data.ByteString.Builder.Prim(primBounded)

17import Control.Arrow((***))

18import Control.Arrow((***))

18import Control.Applicative

19import Control.Applicative

19−import Data.Bits((.&.))

20import qualified Data.ByteString as B

21−import Data.ByteString.Internal (c2w, w2c)

21+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)

22−import Data.Time hiding (getTimeZone, getZonedTime)

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

23import Data.Typeable

24−import Data.Word(Word8)

25import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

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

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

27import Database.PostgreSQL.Simple.Compat ((<>))

26import Database.PostgreSQL.Simple.Compat ((<>))

28−import Data.Monoid(Monoid(..))

29−import Data.Fixed (Pico)

30−import Unsafe.Coerce

31−import qualified Database.PostgreSQL.Simple.Time.Parser as TP

27+import qualified Database.PostgreSQL.Simple.Time.Internal.Parser as TP

32−import Database.PostgreSQL.Simple.Compat (fromPico)

28+import qualified Database.PostgreSQL.Simple.Time.Internal.Printer as TPP

34data Unbounded a

30data Unbounded a

35 = NegInfinity

31 = NegInfinity

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

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

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

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

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

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

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

83+

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

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

86getUnbounded getFinite

85getUnbounded getFinite

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

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

@@ -115,7 +114,7 @@ getTimeZoneHMS = munge <$> TP.timeZoneHMS

115 munge (Just (TP.UTCOffsetHMS h m s)) = (h,m,s)

114 munge (Just (TP.UTCOffsetHMS h m s)) = (h,m,s)

116

115

117localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)

116localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)

118−localToUTCTimeOfDayHMS (dh, dm, ds) tod =

117+localToUTCTimeOfDayHMS (dh, dm, ds) tod =

119 TP.localToUTCTimeOfDayHMS (TP.UTCOffsetHMS dh dm ds) tod

118 TP.localToUTCTimeOfDayHMS (TP.UTCOffsetHMS dh dm ds) tod

120

119

121getZonedTime :: A.Parser ZonedTime

120getZonedTime :: A.Parser ZonedTime

@@ -130,55 +129,26 @@ getUTCTime = TP.utcTime

130getUTCTimestamp :: A.Parser UTCTimestamp

129getUTCTimestamp :: A.Parser UTCTimestamp

131getUTCTimestamp = getUnbounded getUTCTime

130getUTCTimestamp = getUnbounded getUTCTime

132

131

133−toNum :: Num n => B.ByteString -> n

132+getCalendarDiffTime :: A.Parser CalendarDiffTime

134−toNum = toNum_ 0

133+getCalendarDiffTime = TP.calendarDiffTime

135−{-# INLINE toNum #-}

136−

137−toNum_ :: Num n => n -> B.ByteString -> n

138−toNum_ = B.foldl' (\a c -> 10*a + digit c)

139−

140−digit :: Num n => Word8 -> n

141−digit c = fromIntegral (c .&. 0x0f)

142−{-# INLINE digit #-}

143−

144−digits :: Num n => String -> A.Parser n

145−digits msg = do

146− x <- A.anyChar

147− y <- A.anyChar

148− if A.isDigit x && A.isDigit y

149− then return $! (10 * digit (c2w x) + digit (c2w y))

150− else fail (msg <> " is not 2 digits")

151−{-# INLINE digits #-}

152

134

153dayToBuilder :: Day -> Builder

135dayToBuilder :: Day -> Builder

154−dayToBuilder (toGregorian -> (y,m,d)) = do

136+dayToBuilder = primBounded TPP.day

155− pad4 y <> char8 '-' <> pad2 m <> char8 '-' <> pad2 d

156

137

157timeOfDayToBuilder :: TimeOfDay -> Builder

138timeOfDayToBuilder :: TimeOfDay -> Builder

158−timeOfDayToBuilder (TimeOfDay h m s) = do

139+timeOfDayToBuilder = primBounded TPP.timeOfDay

159− pad2 h <> char8 ':' <> pad2 m <> char8 ':' <> showSeconds s

160

140

161timeZoneToBuilder :: TimeZone -> Builder

141timeZoneToBuilder :: TimeZone -> Builder

162−timeZoneToBuilder tz

142+timeZoneToBuilder = primBounded TPP.timeZone

163− | m == 0 = sign h <> pad2 (abs h)

164− | otherwise = sign h <> pad2 (abs h) <> char8 ':' <> pad2 (abs m)

165− where

166− (h,m) = timeZoneMinutes tz `quotRem` 60

167− sign h | h >= 0 = char8 '+'

168− | otherwise = char8 '-'

169

143

170utcTimeToBuilder :: UTCTime -> Builder

144utcTimeToBuilder :: UTCTime -> Builder

171−utcTimeToBuilder (UTCTime day time) =

145+utcTimeToBuilder = primBounded TPP.utcTime

172− dayToBuilder day <> char8 ' '

173− <> timeOfDayToBuilder (timeToTimeOfDay time) <> byteString "+00"

174

146

175zonedTimeToBuilder :: ZonedTime -> Builder

147zonedTimeToBuilder :: ZonedTime -> Builder

176−zonedTimeToBuilder (ZonedTime localTime tz) =

148+zonedTimeToBuilder = primBounded TPP.zonedTime

177− localTimeToBuilder localTime <> timeZoneToBuilder tz

178

149

179localTimeToBuilder :: LocalTime -> Builder

150localTimeToBuilder :: LocalTime -> Builder

180−localTimeToBuilder (LocalTime day tod) =

151+localTimeToBuilder = primBounded TPP.localTime

181− dayToBuilder day <> char8 ' ' <> timeOfDayToBuilder tod

182

152

183unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

153unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

184unboundedToBuilder finiteToBuilder unbounded

154unboundedToBuilder finiteToBuilder unbounded

@@ -200,62 +170,7 @@ dateToBuilder :: Date -> Builder

200dateToBuilder = unboundedToBuilder dayToBuilder

170dateToBuilder = unboundedToBuilder dayToBuilder

201

171

202nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

203−nominalDiffTimeToBuilder xyz

173+nominalDiffTimeToBuilder = TPP.nominalDiffTime

204− | yz < 500000 = sign <> integerDec x

174+

205− | otherwise = sign <> integerDec x <> char8 '.' <> showD6 y

175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

206− where

176+calendarDiffTimeToBuilder = TPP.calendarDiffTime

207− sign = if xyz >= 0 then mempty else char8 '-'

208− -- A kludge to work around the fact that Data.Fixed isn't very fast and

209− -- NominalDiffTime doesn't give the MkNominalDiffTime constructor.

210− (x,yz) = ((unsafeCoerce (abs xyz) :: Integer) + 500000) `quotRem` 1000000000000

211− (fromIntegral -> y, _z) = yz `quotRem` 1000000

212−

213−showSeconds :: Pico -> Builder

214−showSeconds xyz

215− | yz == 0 = pad2 x

216− | z == 0 = pad2 x <> char8 '.' <> showD6 y

217− | otherwise = pad2 x <> char8 '.' <> pad6 y <> showD6 z

218− where

219− (x_,yz) = fromPico xyz `quotRem` 1000000000000

220− x = fromIntegral x_ :: Int

221− (fromIntegral -> y, fromIntegral -> z) = yz `quotRem` 1000000

222−

223−pad6 :: Int -> Builder

224−pad6 xy = let (x,y) = xy `quotRem` 1000

225− in pad3 x <> pad3 y

226−

227−showD6 :: Int -> Builder

228−showD6 xy = case xy `quotRem` 1000 of

229− (x,0) -> showD3 x

230− (x,y) -> pad3 x <> showD3 y

231−

232−pad3 :: Int -> Builder

233−pad3 abc = let (ab,c) = abc `quotRem` 10

234− (a,b) = ab `quotRem` 10

235− in p a <> p b <> p c

236−

237−showD3 :: Int -> Builder

238−showD3 abc = case abc `quotRem` 100 of

239− (a, 0) -> p a

240− (a,bc) -> case bc `quotRem` 10 of

241− (b,0) -> p a <> p b

242− (b,c) -> p a <> p b <> p c

243−

244−-- | p assumes its input is in the range [0..9]

245−p :: Integral n => n -> Builder

246−p n = char8 (w2c (fromIntegral (n + 48)))

247−{-# INLINE p #-}

248−

249−-- | pad2 assumes its input is in the range [0..99]

250−pad2 :: Integral n => n -> Builder

251−pad2 n = let (a,b) = n `quotRem` 10 in p a <> p b

252−{-# INLINE pad2 #-}

253−

254−-- | pad4 assumes its input is positive

255−pad4 :: Integer -> Builder

256−pad4 abcd | abcd >= 10000 = integerDec abcd

257− | otherwise = p a <> p b <> p c <> p d

258− where (ab,cd) = abcd `quotRem` 100

259− (a,b) = ab `quotRem` 10

260− (c,d) = cd `quotRem` 10

261−{-# INLINE pad4 #-}

src/Database/PostgreSQL/Simple/Time/Parser.hs → src/Database/PostgreSQL/Simple/Time/Internal/Parser.hsrenamed+28−19

@@ -1,17 +1,16 @@

1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

3-- |

4−-- Module: Database.PostgreSQL.Simple.Time.Parser

4+-- Module: Database.PostgreSQL.Simple.Time.Internal.Parser

7-- License: BSD3

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

9-- Stability: experimental

10−-- Portability: portable

11--

10--

12-- Parsers for parsing dates and times.

11-- Parsers for parsing dates and times.

14−module Database.PostgreSQL.Simple.Time.Parser

13+module Database.PostgreSQL.Simple.Time.Internal.Parser

15 (

14 (

16 day

15 day

17 , localTime

16 , localTime

@@ -22,20 +21,24 @@ module Database.PostgreSQL.Simple.Time.Parser

22 , localToUTCTimeOfDayHMS

21 , localToUTCTimeOfDayHMS

23 , utcTime

22 , utcTime

24 , zonedTime

23 , zonedTime

24+ , calendarDiffTime

25 ) where

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

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

29import Data.Attoparsec.ByteString.Char8 as A

30import Data.Bits ((.&.))

31+import Data.ByteString (ByteString)

31import Data.Char (ord)

32import Data.Char (ord)

32import Data.Fixed (Pico)

33import Data.Fixed (Pico)

33import Data.Int (Int64)

34import Data.Int (Int64)

34import Data.Maybe (fromMaybe)

35import Data.Maybe (fromMaybe)

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

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

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

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

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

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

37import qualified Data.ByteString.Char8 as B8

40import qualified Data.ByteString.Char8 as B8

38−import qualified Data.Time.LocalTime as Local

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

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

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

41day :: Parser Day

44day :: Parser Day

@@ -53,18 +56,19 @@ twoDigits = do

53 let c2d c = ord c .&. 15

56 let c2d c = ord c .&. 15

54 return $! c2d a * 10 + c2d b

57 return $! c2d a * 10 + c2d b

56−-- | Parse a time of the form @HH:MM:SS[.SSS]@.

59+-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.

57timeOfDay :: Parser Local.TimeOfDay

60timeOfDay :: Parser Local.TimeOfDay

58timeOfDay = do

61timeOfDay = do

59 h <- twoDigits <* char ':'

62 h <- twoDigits <* char ':'

60− m <- twoDigits <* char ':'

63+ m <- twoDigits

64+ mc <- peekChar

65+ s <- case mc of

61− s <- seconds

66+ Just ':' -> anyChar *> seconds

67+ _ -> return 0

62 if h < 24 && m < 60 && s <= 60

68 if h < 24 && m < 60 && s <= 60

63 then return (Local.TimeOfDay h m s)

69 then return (Local.TimeOfDay h m s)

64 else fail "invalid time"

70 else fail "invalid time"

66−data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64

67−

68-- | Parse a count of seconds, with the integer part being two digits

72-- | Parse a count of seconds, with the integer part being two digits

69-- long.

73-- long.

70seconds :: Parser Pico

74seconds :: Parser Pico

@@ -74,20 +78,20 @@ seconds = do

74 case mc of

78 case mc of

75 Just '.' -> do

79 Just '.' -> do

76 t <- anyChar *> takeWhile1 isDigit

80 t <- anyChar *> takeWhile1 isDigit

77− return $! parsePicos real t

81+ return $! parsePicos (fromIntegral real) t

78 _ -> return $! fromIntegral real

82 _ -> return $! fromIntegral real

79 where

83 where

84+ parsePicos :: Int64 -> B8.ByteString -> Pico

80 parsePicos a0 t = toPico (fromIntegral (t' * 10^n))

85 parsePicos a0 t = toPico (fromIntegral (t' * 10^n))

81− where T n t' = B8.foldl' step (T 12 (fromIntegral a0)) t

86+ where n = max 0 (12 - B8.length t)

82− step ma@(T m a) c

83− | m <= 0 = ma

84− | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)

87+ t' = B8.foldl' (\a c -> 10 * a + fromIntegral (ord c .&. 15)) a0

88+ (B8.take 12 t)

86-- | Parse a time zone, and return 'Nothing' if the offset from UTC is

90-- | Parse a time zone, and return 'Nothing' if the offset from UTC is

87-- zero. (This makes some speedups possible.)

91-- zero. (This makes some speedups possible.)

88timeZone :: Parser (Maybe Local.TimeZone)

92timeZone :: Parser (Maybe Local.TimeZone)

89timeZone = do

93timeZone = do

90− ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'

94+ ch <- satisfy $ \c -> c == '+' || c == '-' || c == 'Z'

91 if ch == 'Z'

95 if ch == 'Z'

92 then return Nothing

96 then return Nothing

93 else do

97 else do

@@ -114,7 +118,7 @@ data UTCOffsetHMS = UTCOffsetHMS {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNP

114-- zero. (This makes some speedups possible.)

118-- zero. (This makes some speedups possible.)

115timeZoneHMS :: Parser (Maybe UTCOffsetHMS)

119timeZoneHMS :: Parser (Maybe UTCOffsetHMS)

116timeZoneHMS = do

120timeZoneHMS = do

117− ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'

121+ ch <- satisfy $ \c -> c == '+' || c == '-' || c == 'Z'

118 if ch == 'Z'

122 if ch == 'Z'

119 then return Nothing

123 then return Nothing

120 else do

124 else do

@@ -163,7 +167,7 @@ localToUTCTimeOfDayHMS (UTCOffsetHMS dh dm ds) (Local.TimeOfDay h m s) =

163-- followed by a fractional component.

167-- followed by a fractional component.

164localTime :: Parser Local.LocalTime

168localTime :: Parser Local.LocalTime

165localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay

169localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay

166− where daySep = satisfy (\c -> c == 'T' || c == ' ')

170+ where daySep = satisfy (\c -> c == ' ' || c == 'T')

167

171

168-- | Behaves as 'zonedTime', but converts any time zone offset into a

172-- | Behaves as 'zonedTime', but converts any time zone offset into a

169-- UTC time.

173-- UTC time.

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

193

197

194utc :: Local.TimeZone

198utc :: Local.TimeZone

195utc = Local.TimeZone 0 False ""

199utc = Local.TimeZone 0 False ""

200+

201+calendarDiffTime :: Parser CalendarDiffTime

202+calendarDiffTime = do

203+ contents <- takeByteString

204+ iso8601ParseM $ B8.unpack contents

src/Database/PostgreSQL/Simple/Time/Internal/Printer.hsnew file+135

@@ -0,0 +1,135 @@

1+{-# LANGUAGE BangPatterns, ViewPatterns #-}

3+------------------------------------------------------------------------------

4+-- Module: Database.PostgreSQL.Simple.Time.Internal.Printer

6+-- License: BSD3

7+-- Maintainer: Leon P Smith <leon@melding-monads.com>

8+-- Stability: experimental

9+------------------------------------------------------------------------------

10+

11+module Database.PostgreSQL.Simple.Time.Internal.Printer

12+ (

13+ day

14+ , timeOfDay

15+ , timeZone

16+ , utcTime

17+ , localTime

18+ , zonedTime

19+ , nominalDiffTime

20+ , calendarDiffTime

21+ ) where

22+

23+import Control.Arrow ((>>>))

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

25+import Data.ByteString.Builder.Prim

26+ ( liftFixedToBounded, (>$<), (>*<)

27+ , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

28+import Data.Char ( chr )

29+import Data.Int ( Int32, Int64 )

30+import Data.String (fromString)

31+import Data.Time.Compat

32+ ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

33+ , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

34+ , TimeZone, timeZoneMinutes )

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

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

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

38+import Unsafe.Coerce (unsafeCoerce)

39+

40+liftB :: FixedPrim a -> BoundedPrim a

41+liftB = liftFixedToBounded

42+

43+digit :: FixedPrim Int

44+digit = (\x -> chr (x + 48)) >$< char8

45+

46+digits2 :: FixedPrim Int

47+digits2 = (`quotRem` 10) >$< (digit >*< digit)

48+

49+digits3 :: FixedPrim Int

50+digits3 = (`quotRem` 10) >$< (digits2 >*< digit)

51+

52+digits4 :: FixedPrim Int

53+digits4 = (`quotRem` 10) >$< (digits3 >*< digit)

54+

55+frac :: BoundedPrim Int64

56+frac = condB (== 0) emptyB ((,) '.' >$< (liftB char8 >*< trunc12))

57+ where

58+ trunc12 :: BoundedPrim Int64

59+ trunc12 = (`quotRem` 1000000) >$<

60+ condB (\(_,y) -> y == 0)

61+ (fst >$< trunc6)

62+ (liftB digits6 >*< trunc6)

63+

64+ digitB = liftB digit

65+

66+ digits6 = (fromIntegral >>> (`quotRem` 10)) >$< (digits5 >*< digit)

67+ digits5 = (`quotRem` 10) >$< (digits4 >*< digit)

68+

69+ trunc6 = (fromIntegral >>> (`quotRem` 100000)) >$< (digitB >*< trunc5)

70+ trunc5 = condB (== 0) emptyB ((`quotRem` 10000) >$< (digitB >*< trunc4))

71+ trunc4 = condB (== 0) emptyB ((`quotRem` 1000) >$< (digitB >*< trunc3))

72+ trunc3 = condB (== 0) emptyB ((`quotRem` 100) >$< (digitB >*< trunc2))

73+ trunc2 = condB (== 0) emptyB ((`quotRem` 10) >$< (digitB >*< trunc1))

74+ trunc1 = condB (== 0) emptyB digitB

75+

76+

77+year :: BoundedPrim Int32

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

79+ where

80+ checkBCE :: Int32 -> Int

81+ checkBCE y

82+ | y > 0 = fromIntegral y

83+ | otherwise = error msg

84+

85+ msg = "Database.PostgreSQL.Simple.Time.Printer.year: years BCE not supported"

86+

87+day :: BoundedPrim Day

88+day = toYMD >$< (year >*< liftB (char8 >*< digits2 >*< char8 >*< digits2))

89+ where

90+ toYMD (toGregorian -> (fromIntegral -> !y, !m,!d)) = (y,('-',(m,('-',d))))

91+

92+timeOfDay :: BoundedPrim TimeOfDay

93+timeOfDay = f >$< (hh_mm_ >*< ss)

94+ where

95+ f (TimeOfDay h m s) = ((h,(':',(m,':'))),s)

96+

97+ hh_mm_ = liftB (digits2 >*< char8 >*< digits2 >*< char8)

98+

99+ ss = (\s -> fromIntegral (fromPico s) `quotRem` 1000000000000) >$<

100+ (liftB (fromIntegral >$< digits2) >*< frac)

101+

102+timeZone :: BoundedPrim TimeZone

103+timeZone = timeZoneMinutes >$< tz

104+ where

105+ tz = condB (>= 0) ((,) '+' >$< tzh) ((,) '-' . negate >$< tzh)

106+

107+ tzh = liftB char8 >*< ((`quotRem` 60) >$< (liftB digits2 >*< tzm))

108+

109+ tzm = condB (==0) emptyB ((,) ':' >$< liftB (char8 >*< digits2))

110+

111+utcTime :: BoundedPrim UTCTime

112+utcTime = f >$< (day >*< liftB char8 >*< timeOfDay >*< liftB char8)

113+ where f (UTCTime d (timeToTimeOfDay -> tod)) = (d,(' ',(tod,'Z')))

114+

115+localTime :: BoundedPrim LocalTime

116+localTime = f >$< (day >*< liftB char8 >*< timeOfDay)

117+ where f (LocalTime d tod) = (d, (' ', tod))

118+

119+zonedTime :: BoundedPrim ZonedTime

120+zonedTime = f >$< (localTime >*< timeZone)

121+ where f (ZonedTime lt tz) = (lt, tz)

122+

123+

124+nominalDiffTime :: NominalDiffTime -> Builder

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

126+ where

127+ (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

128+

129+calendarDiffTime :: CalendarDiffTime -> Builder

130+calendarDiffTime = byteString

131+ . fromString

132+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".

133+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted

134+ -- to ASCII output.

135+ . iso8601Show

src/Database/PostgreSQL/Simple/ToField.hs+42−17

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

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

2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3+{-# LANGUAGE PolyKinds #-}

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

5------------------------------------------------------------------------------

5-- |

6-- |

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

22 , inQuotes

23 , inQuotes

23 ) where

24 ) where

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

25import qualified Data.Aeson as JSON

27import qualified Data.Aeson as JSON

26import Data.ByteString (ByteString)

28import Data.ByteString (ByteString)

27import Data.ByteString.Builder

29import Data.ByteString.Builder

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

30 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

32 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

31 , floatDec, doubleDec

33 , floatDec, doubleDec

32 )

34 )

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

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

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

34import Data.List (intersperse)

37import Data.List (intersperse)

35import Data.Monoid (mappend)

38import Data.Monoid (mappend)

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

39+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

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

37import Data.Typeable (Typeable)

41import Data.Typeable (Typeable)

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

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

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

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

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

43import qualified Data.ByteString as SB

47import qualified Data.ByteString as SB

44import qualified Data.ByteString.Lazy as LB

48import qualified Data.ByteString.Lazy as LB

49+import Data.CaseInsensitive (CI)

50+import qualified Data.CaseInsensitive as CI

45import qualified Data.Text as ST

51import qualified Data.Text as ST

46import qualified Data.Text.Encoding as ST

52import qualified Data.Text.Encoding as ST

47import qualified Data.Text.Lazy as LT

53import qualified Data.Text.Lazy as LT

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

53import qualified Database.PostgreSQL.LibPQ as PQ

59import qualified Database.PostgreSQL.LibPQ as PQ

54import Database.PostgreSQL.Simple.Time

60import Database.PostgreSQL.Simple.Time

55import Data.Scientific (Scientific)

61import Data.Scientific (Scientific)

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

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

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

58−#else

59−import Data.Scientific (scientificBuilder)

60−#endif

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

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

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

65-- | How to render an element when substituting it into a query.

@@ -98,6 +100,14 @@ instance ToField Action where

98 toField a = a

100 toField a = a

99 {-# INLINE toField #-}

101 {-# INLINE toField #-}

100

102

103+instance (ToField a) => ToField (Const a b) where

104+ toField (Const a) = toField a

105+ {-# INLINE toField #-}

106+

107+instance (ToField a) => ToField (Identity a) where

108+ toField (Identity a) = toField a

109+ {-# INLINE toField #-}

110+

101instance (ToField a) => ToField (Maybe a) where

111instance (ToField a) => ToField (Maybe a) where

102 toField Nothing = renderNull

112 toField Nothing = renderNull

103 toField (Just a) = toField a

113 toField (Just a) = toField a

@@ -230,6 +240,15 @@ instance ToField LT.Text where

230 toField = toField . LT.toStrict

240 toField = toField . LT.toStrict

231 {-# INLINE toField #-}

241 {-# INLINE toField #-}

232

242

243+-- | citext

244+instance ToField (CI ST.Text) where

245+ toField = toField . CI.original

246+ {-# INLINE toField #-}

247+

248+-- | citext

249+instance ToField (CI LT.Text) where

250+ toField = toField . LT.toStrict . CI.original

251+ {-# INLINE toField #-}

233

252

234instance ToField UTCTime where

253instance ToField UTCTime where

235 toField = Plain . inQuotes . utcTimeToBuilder

254 toField = Plain . inQuotes . utcTimeToBuilder

@@ -271,13 +290,20 @@ instance ToField NominalDiffTime where

271 toField = Plain . inQuotes . nominalDiffTimeToBuilder

290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

272 {-# INLINE toField #-}

291 {-# INLINE toField #-}

273

292

293+instance ToField CalendarDiffTime where

294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

295+ {-# INLINE toField #-}

296+

274instance (ToField a) => ToField (PGArray a) where

297instance (ToField a) => ToField (PGArray a) where

275− toField xs = Many $

298+ toField pgArray =

299+ case fromPGArray pgArray of

300+ [] -> Plain (byteString "'{}'")

301+ xs -> Many $

276− Plain (byteString "ARRAY[") :

302+ Plain (byteString "ARRAY[") :

277− (intersperse (Plain (char8 ',')) . map toField $ fromPGArray xs) ++

303+ (intersperse (Plain (char8 ',')) . map toField $ xs) ++

278− [Plain (char8 ']')]

304+ [Plain (char8 ']')]

279− -- Because the ARRAY[...] input syntax is being used, it is possible

305+ -- Because the ARRAY[...] input syntax is being used, it is possible

280− -- that the use of type-specific separator characters is unnecessary.

306+ -- that the use of type-specific separator characters is unnecessary.

281

307

282instance (ToField a) => ToField (Vector a) where

308instance (ToField a) => ToField (Vector a) where

283 toField = toField . PGArray . V.toList

309 toField = toField . PGArray . V.toList

@@ -288,14 +314,13 @@ instance ToField UUID where

288instance ToField JSON.Value where

314instance ToField JSON.Value where

289 toField = toField . JSON.encode

315 toField = toField . JSON.encode

290

316

291−-- | Convert a Haskell value to a JSON 'JSON.Value' using

317+-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.

292−-- 'JSON.toJSON' and convert that to a field using 'toField'.

293--

318--

294-- This can be used as the default implementation for the 'toField'

319-- This can be used as the default implementation for the 'toField'

295-- method for Haskell types that have a JSON representation in

320-- method for Haskell types that have a JSON representation in

296-- PostgreSQL.

321-- PostgreSQL.

297toJSONField :: JSON.ToJSON a => a -> Action

322toJSONField :: JSON.ToJSON a => a -> Action

298−toJSONField = toField . JSON.toJSON

323+toJSONField = toField . JSON.encode

299

324

300-- | Surround a string with single-quote characters: \"@'@\"

325-- | Surround a string with single-quote characters: \"@'@\"

301--

326--

@@ -305,7 +330,7 @@ inQuotes b = quote `mappend` b `mappend` quote

305 where quote = char8 '\''

330 where quote = char8 '\''

306

331

307interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

332interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

308−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

309{-# INLINE interleaveFoldr #-}

334{-# INLINE interleaveFoldr #-}

310

335

311instance ToRow a => ToField (Values a) where

336instance ToRow a => ToField (Values a) where

@@ -352,8 +377,8 @@ instance ToRow a => ToField (Values a) where

352

377

353 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

378 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

354 typedRows [] _ _ = error funcname

379 typedRows [] _ _ = error funcname

355− typedRows (val:vals) types rest =

380+ typedRows (val:vals) typs rest =

356− typedRow (toRow val) types (multiRows vals rest)

381+ typedRow (toRow val) typs (multiRows vals rest)

357

382

358 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

383 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

359 untypedRows [] _ = error funcname

384 untypedRows [] _ = error funcname

src/Database/PostgreSQL/Simple/ToRow.hs+127

@@ -1,3 +1,4 @@

1+{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}

1------------------------------------------------------------------------------

2------------------------------------------------------------------------------

2-- |

3-- |

3-- Module: Database.PostgreSQL.Simple.ToRow

4-- Module: Database.PostgreSQL.Simple.ToRow

@@ -22,14 +23,33 @@ module Database.PostgreSQL.Simple.ToRow

23import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))

24import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))

24import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))

25import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))

26+import GHC.Generics

26-- | A collection type that can be turned into a list of rendering

28-- | A collection type that can be turned into a list of rendering

27-- 'Action's.

29-- 'Action's.

28--

30--

29-- Instances should use the 'toField' method of the 'ToField' class

31-- Instances should use the 'toField' method of the 'ToField' class

30-- to perform conversion of each element of the collection.

32-- to perform conversion of each element of the collection.

33+--

34+-- You can derive 'ToRow' for your data type using GHC generics, like this:

35+--

36+-- @

37+-- \{-# LANGUAGE DeriveAnyClass \#-}

38+-- \{-# LANGUAGE DeriveGeneric \#-}

39+--

40+-- import "GHC.Generics" ('GHC.Generics.Generic')

41+-- import "Database.PostgreSQL.Simple" ('ToRow')

42+--

43+-- data User = User { name :: String, fileQuota :: Int }

44+-- deriving ('GHC.Generics.Generic', 'ToRow')

45+-- @

46+--

47+-- Note that this only works for product types (e.g. records) and does not

48+-- support sum types or recursive types.

31class ToRow a where

49class ToRow a where

32 toRow :: a -> [Action]

50 toRow :: a -> [Action]

51+ default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

52+ toRow = gtoRow . from

33 -- ^ ToField a collection of values.

53 -- ^ ToField a collection of values.

35instance ToRow () where

55instance ToRow () where

@@ -85,8 +105,115 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

85 [toField a, toField b, toField c, toField d, toField e, toField f,

105 [toField a, toField b, toField c, toField d, toField e, toField f,

86 toField g, toField h, toField i, toField j]

106 toField g, toField h, toField i, toField j]

107

108+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

109+ ToField g, ToField h, ToField i, ToField j, ToField k)

110+ => ToRow (a,b,c,d,e,f,g,h,i,j,k) where

111+ toRow (a,b,c,d,e,f,g,h,i,j,k) =

112+ [toField a, toField b, toField c, toField d, toField e, toField f,

113+ toField g, toField h, toField i, toField j, toField k]

114+

115+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

116+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l)

117+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where

118+ toRow (a,b,c,d,e,f,g,h,i,j,k,l) =

119+ [toField a, toField b, toField c, toField d, toField e, toField f,

120+ toField g, toField h, toField i, toField j, toField k, toField l]

121+

122+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

123+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

124+ ToField m)

125+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where

126+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m) =

127+ [toField a, toField b, toField c, toField d, toField e, toField f,

128+ toField g, toField h, toField i, toField j, toField k, toField l,

129+ toField m]

130+

131+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

132+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

133+ ToField m, ToField n)

134+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where

135+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =

136+ [toField a, toField b, toField c, toField d, toField e, toField f,

137+ toField g, toField h, toField i, toField j, toField k, toField l,

138+ toField m, toField n]

139+

140+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

141+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

142+ ToField m, ToField n, ToField o)

143+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where

144+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =

145+ [toField a, toField b, toField c, toField d, toField e, toField f,

146+ toField g, toField h, toField i, toField j, toField k, toField l,

147+ toField m, toField n, toField o]

148+

149+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

150+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

151+ ToField m, ToField n, ToField o, ToField p)

152+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where

153+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) =

154+ [toField a, toField b, toField c, toField d, toField e, toField f,

155+ toField g, toField h, toField i, toField j, toField k, toField l,

156+ toField m, toField n, toField o, toField p]

157+

158+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

159+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

160+ ToField m, ToField n, ToField o, ToField p, ToField q)

161+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where

162+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) =

163+ [toField a, toField b, toField c, toField d, toField e, toField f,

164+ toField g, toField h, toField i, toField j, toField k, toField l,

165+ toField m, toField n, toField o, toField p, toField q]

166+

167+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

168+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

169+ ToField m, ToField n, ToField o, ToField p, ToField q, ToField r)

170+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where

171+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) =

172+ [toField a, toField b, toField c, toField d, toField e, toField f,

173+ toField g, toField h, toField i, toField j, toField k, toField l,

174+ toField m, toField n, toField o, toField p, toField q, toField r]

175+

176+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

177+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

178+ ToField m, ToField n, ToField o, ToField p, ToField q, ToField r,

179+ ToField s)

180+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where

181+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) =

182+ [toField a, toField b, toField c, toField d, toField e, toField f,

183+ toField g, toField h, toField i, toField j, toField k, toField l,

184+ toField m, toField n, toField o, toField p, toField q, toField r,

185+ toField s]

186+

187+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,

188+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,

189+ ToField m, ToField n, ToField o, ToField p, ToField q, ToField r,

190+ ToField s, ToField t)

191+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where

192+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) =

193+ [toField a, toField b, toField c, toField d, toField e, toField f,

194+ toField g, toField h, toField i, toField j, toField k, toField l,

195+ toField m, toField n, toField o, toField p, toField q, toField r,

196+ toField s, toField t]

197+

88instance (ToField a) => ToRow [a] where

198instance (ToField a) => ToRow [a] where

89 toRow = map toField

199 toRow = map toField

200

91instance (ToRow a, ToRow b) => ToRow (a :. b) where

201instance (ToRow a, ToRow b) => ToRow (a :. b) where

92 toRow (a :. b) = toRow a ++ toRow b

202 toRow (a :. b) = toRow a ++ toRow b

203+

204+

205+-- Type class for default implementation of ToRow using generics

206+class GToRow f where

207+ gtoRow :: f p -> [Action]

208+

209+instance GToRow f => GToRow (M1 c i f) where

210+ gtoRow (M1 x) = gtoRow x

211+

212+instance (GToRow f, GToRow g) => GToRow (f :*: g) where

213+ gtoRow (f :*: g) = gtoRow f ++ gtoRow g

214+

215+instance (ToField a) => GToRow (K1 R a) where

216+ gtoRow (K1 a) = [toField a]

217+

218+instance GToRow U1 where

219+ gtoRow _ = []

src/Database/PostgreSQL/Simple/ToRow.hs-boot+10−1

@@ -1,9 +1,18 @@

1+{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}

1−module Database.PostgreSQL.Simple.ToRow where

2+module Database.PostgreSQL.Simple.ToRow (

3+ ToRow(..)

4+ ) where

3import Database.PostgreSQL.Simple.Types

6import Database.PostgreSQL.Simple.Types

4import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField

7import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField

8+import GHC.Generics

6class ToRow a where

10class ToRow a where

7 toRow :: a -> [Action]

11 toRow :: a -> [Action]

12+ default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

13+ toRow = gtoRow . from

14+

15+class GToRow f where

16+ gtoRow :: f p -> [Action]

9instance ToField a => ToRow (Only a)

18instance ToField a => ToRow (Only a)

src/Database/PostgreSQL/Simple/Transaction.hs+35−17

@@ -1,4 +1,14 @@

1−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}

3+------------------------------------------------------------------------------

4+-- |

5+-- Module: Database.PostgreSQL.Simple.Transaction

8+-- License: BSD3

9+-- Maintainer: Leon P Smith <leon@melding-monads.com>

10+--

11+------------------------------------------------------------------------------

3module Database.PostgreSQL.Simple.Transaction

13module Database.PostgreSQL.Simple.Transaction

4 (

14 (

@@ -7,6 +17,7 @@ module Database.PostgreSQL.Simple.Transaction

7 , withTransactionLevel

17 , withTransactionLevel

8 , withTransactionMode

18 , withTransactionMode

9 , withTransactionModeRetry

19 , withTransactionModeRetry

20+ , withTransactionModeRetry'

10 , withTransactionSerializable

21 , withTransactionSerializable

11 , TransactionMode(..)

22 , TransactionMode(..)

12 , IsolationLevel(..)

23 , IsolationLevel(..)

@@ -45,7 +56,7 @@ import Database.PostgreSQL.Simple.Compat (mask, (<>))

46-- | Of the four isolation levels defined by the SQL standard,

57-- | Of the four isolation levels defined by the SQL standard,

47-- these are the three levels distinguished by PostgreSQL as of version 9.0.

58-- these are the three levels distinguished by PostgreSQL as of version 9.0.

48−-- See <http://www.postgresql.org/docs/9.1/static/transaction-iso.html>

59+-- See <https://www.postgresql.org/docs/9.5/static/transaction-iso.html>

49-- for more information. Note that prior to PostgreSQL 9.0, 'RepeatableRead'

60-- for more information. Note that prior to PostgreSQL 9.0, 'RepeatableRead'

50-- was equivalent to 'Serializable'.

61-- was equivalent to 'Serializable'.

@@ -132,41 +143,48 @@ withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a

132withTransactionMode mode conn act =

143withTransactionMode mode conn act =

133 mask $ \restore -> do

144 mask $ \restore -> do

134 beginMode mode conn

145 beginMode mode conn

135− r <- restore act `E.onException` rollback conn

146+ r <- restore act `E.onException` rollback_ conn

136 commit conn

147 commit conn

137 return r

148 return r

138

149

150+-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.

151+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

152+withTransactionModeRetry = withTransactionModeRetry'

153+

139-- | Like 'withTransactionMode', but also takes a custom callback to

154-- | Like 'withTransactionMode', but also takes a custom callback to

140−-- determine if a transaction should be retried if an 'SqlError' occurs.

155+-- determine if a transaction should be retried if an exception occurs.

141−-- If the callback returns True, then the transaction will be retried.

156+-- If the callback returns 'True', then the transaction will be retried.

142−-- If the callback returns False, or an exception other than an 'SqlError'

157+-- If the callback returns 'False', or an exception other than an @e@

143-- occurs then the transaction will be rolled back and the exception rethrown.

158-- occurs then the transaction will be rolled back and the exception rethrown.

144--

159--

145-- This is used to implement 'withTransactionSerializable'.

160-- This is used to implement 'withTransactionSerializable'.

146−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

161+withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a

147−withTransactionModeRetry mode shouldRetry conn act =

162+withTransactionModeRetry' mode shouldRetry conn act =

148 mask $ \restore ->

163 mask $ \restore ->

149 retryLoop $ E.try $ do

164 retryLoop $ E.try $ do

150− a <- restore act

165+ a <- restore act `E.onException` rollback_ conn

151 commit conn

166 commit conn

152 return a

167 return a

153 where

168 where

154− retryLoop :: IO (Either E.SomeException a) -> IO a

169+ retryLoop :: IO (Either e a) -> IO a

155 retryLoop act' = do

170 retryLoop act' = do

156 beginMode mode conn

171 beginMode mode conn

157 r <- act'

172 r <- act'

158 case r of

173 case r of

159− Left e -> do

174+ Left e ->

160− rollback conn

161− case fmap shouldRetry (E.fromException e) of

175+ case shouldRetry e of

162− Just True -> retryLoop act'

176+ True -> retryLoop act'

163− _ -> E.throwIO e

177+ False -> E.throwIO e

164 Right a ->

178 Right a ->

165 return a

179 return a

166

180

167-- | Rollback a transaction.

181-- | Rollback a transaction.

168rollback :: Connection -> IO ()

182rollback :: Connection -> IO ()

169−rollback conn = execute_ conn "ABORT" >> return ()

183+rollback conn = execute_ conn "ROLLBACK" >> return ()

184+

185+-- | Rollback a transaction, ignoring any @IOErrors@

186+rollback_ :: Connection -> IO ()

187+rollback_ conn = rollback conn `E.catch` \(_ :: IOError) -> return ()

170

188

171-- | Commit a transaction.

189-- | Commit a transaction.

172commit :: Connection -> IO ()

190commit :: Connection -> IO ()

@@ -203,7 +221,7 @@ beginMode mode conn = do

203-- be used inside of a transaction, and provides a sort of

221-- be used inside of a transaction, and provides a sort of

204-- \"nested transaction\".

222-- \"nested transaction\".

205--

223--

206−-- See <http://www.postgresql.org/docs/current/static/sql-savepoint.html>

224+-- See <https://www.postgresql.org/docs/9.5/static/sql-savepoint.html>

207withSavepoint :: Connection -> IO a -> IO a

225withSavepoint :: Connection -> IO a -> IO a

208withSavepoint conn body =

226withSavepoint conn body =

209 mask $ \restore -> do

227 mask $ \restore -> do

src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9

@@ -50,21 +50,21 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

50-- in the connections's cache.

52getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo

53−getTypeInfo conn@Connection{..} oid =

53+getTypeInfo conn@Connection{..} oid' =

54− case staticTypeInfo oid of

54+ case staticTypeInfo oid' of

55− Just name -> return name

55+ Just name' -> return name'

56− Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid

56+ Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid'

58getTypeInfo' :: Connection -> PQ.Oid -> TypeInfoCache

59 -> IO (TypeInfoCache, TypeInfo)

60−getTypeInfo' conn oid oidmap =

60+getTypeInfo' conn oid' oidmap =

61− case IntMap.lookup (oid2int oid) oidmap of

61+ case IntMap.lookup (oid2int oid') oidmap of

62 Just typeinfo -> return (oidmap, typeinfo)

63 Nothing -> do

64 names <- query conn "SELECT oid, typcategory, typdelim, typname,\

65 \ typelem, typrelid\

66 \ FROM pg_type WHERE oid = ?"

67− (Only oid)

67+ (Only oid')

68 (oidmap', typeInfo) <-

69 case names of

70 [] -> return $ throw (fatalError "invalid type oid")

@@ -78,7 +78,7 @@ getTypeInfo' conn oid oidmap =

78 rngsubtypeOids <- query conn "SELECT rngsubtype\

79 \ FROM pg_range\

80 \ WHERE rngtypid = ?"

81− (Only oid)

81+ (Only oid')

82 case rngsubtypeOids of

83 [Only rngsubtype_] -> do

84 (oidmap', rngsubtype) <-

@@ -104,7 +104,7 @@ getTypeInfo' conn oid oidmap =

104 _ -> fail "typename query returned more than one result"

105 -- oid is a primary key, so the query should

106 -- never return more than one result

107− let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'

107+ let !oidmap'' = IntMap.insert (oid2int oid') typeInfo oidmap'

108 return $! (oidmap'', typeInfo)

109

110getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache

src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+9−3

@@ -1,4 +1,9 @@

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

1{-# LANGUAGE TemplateHaskell #-}

5{-# LANGUAGE TemplateHaskell #-}

6+#endif

3------------------------------------------------------------------------------

8------------------------------------------------------------------------------

4-- |

9-- |

@@ -22,11 +27,12 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

22import Database.PostgreSQL.Simple.Types (Oid(..))

27import Database.PostgreSQL.Simple.Types (Oid(..))

23import Language.Haskell.TH

28import Language.Haskell.TH

25−

26-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

30-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

27-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

31-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

28mkCompats :: [TypeInfo] -> ExpQ

32mkCompats :: [TypeInfo] -> ExpQ

33+mkCompats tys = do

34+ x <- newName "x"

29−mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

35+ lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])

30 where

36 where

31 alt :: TypeInfo -> MatchQ

37 alt :: TypeInfo -> MatchQ

32 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

38 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

@@ -38,7 +44,7 @@ mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

38-- Returns an expression of type 'Oid'. Useful because GHC tends

44-- Returns an expression of type 'Oid'. Useful because GHC tends

39-- not to fold constants.

45-- not to fold constants.

40inlineTypoid :: TypeInfo -> ExpQ

46inlineTypoid :: TypeInfo -> ExpQ

41−inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]

47+inlineTypoid ty = conE 'Oid `appE` litE (getTypoid ty)

43inlineTypoidP :: TypeInfo -> PatQ

49inlineTypoidP :: TypeInfo -> PatQ

44inlineTypoidP ty = litP (getTypoid ty)

50inlineTypoidP ty = litP (getTypoid ty)

src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+684−114

@@ -19,119 +19,233 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

19 ( TypeInfo(..)

20 , staticTypeInfo

21 , bool

22+ , boolOid

22 , bytea

23 , bytea

24+ , byteaOid

23 , char

25 , char

26+ , charOid

24 , name

27 , name

28+ , nameOid

25 , int8

29 , int8

30+ , int8Oid

26 , int2

31 , int2

32+ , int2Oid

27 , int4

33 , int4

34+ , int4Oid

28 , regproc

35 , regproc

36+ , regprocOid

29 , text

37 , text

38+ , textOid

30 , oid

39 , oid

40+ , oidOid

31 , tid

41 , tid

42+ , tidOid

32 , xid

43 , xid

44+ , xidOid

33 , cid

45 , cid

46+ , cidOid

34 , xml

47 , xml

48+ , xmlOid

35 , point

49 , point

50+ , pointOid

36 , lseg

51 , lseg

52+ , lsegOid

37 , path

53 , path

54+ , pathOid

38 , box

55 , box

56+ , boxOid

39 , polygon

57 , polygon

58+ , polygonOid

40 , line

59 , line

60+ , lineOid

41 , cidr

61 , cidr

62+ , cidrOid

42 , float4

63 , float4

64+ , float4Oid

43 , float8

65 , float8

66+ , float8Oid

44 , unknown

67 , unknown

68+ , unknownOid

45 , circle

69 , circle

70+ , circleOid

46 , money

71 , money

72+ , moneyOid

47 , macaddr

73 , macaddr

74+ , macaddrOid

48 , inet

75 , inet

76+ , inetOid

49 , bpchar

77 , bpchar

78+ , bpcharOid

50 , varchar

79 , varchar

80+ , varcharOid

51 , date

81 , date

82+ , dateOid

52 , time

83 , time

84+ , timeOid

53 , timestamp

85 , timestamp

86+ , timestampOid

54 , timestamptz

87 , timestamptz

88+ , timestamptzOid

55 , interval

89 , interval

90+ , intervalOid

56 , timetz

91 , timetz

92+ , timetzOid

57 , bit

93 , bit

94+ , bitOid

58 , varbit

95 , varbit

96+ , varbitOid

59 , numeric

97 , numeric

98+ , numericOid

60 , refcursor

99 , refcursor

100+ , refcursorOid

61 , record

101 , record

102+ , recordOid

62 , void

103 , void

104+ , voidOid

63 , array_record

105 , array_record

106+ , array_recordOid

64 , regprocedure

107 , regprocedure

108+ , regprocedureOid

65 , regoper

109 , regoper

110+ , regoperOid

66 , regoperator

111 , regoperator

112+ , regoperatorOid

67 , regclass

113 , regclass

114+ , regclassOid

68 , regtype

115 , regtype

116+ , regtypeOid

69 , uuid

117 , uuid

118+ , uuidOid

70 , json

119 , json

120+ , jsonOid

71 , jsonb

121 , jsonb

122+ , jsonbOid

72 , int2vector

123 , int2vector

124+ , int2vectorOid

73 , oidvector

125 , oidvector

126+ , oidvectorOid

74 , array_xml

127 , array_xml

128+ , array_xmlOid

75 , array_json

129 , array_json

130+ , array_jsonOid

76 , array_line

131 , array_line

132+ , array_lineOid

77 , array_cidr

133 , array_cidr

134+ , array_cidrOid

78 , array_circle

135 , array_circle

136+ , array_circleOid

79 , array_money

137 , array_money

138+ , array_moneyOid

80 , array_bool

139 , array_bool

140+ , array_boolOid

81 , array_bytea

141 , array_bytea

142+ , array_byteaOid

82 , array_char

143 , array_char

144+ , array_charOid

83 , array_name

145 , array_name

146+ , array_nameOid

84 , array_int2

147 , array_int2

148+ , array_int2Oid

85 , array_int2vector

149 , array_int2vector

150+ , array_int2vectorOid

86 , array_int4

151 , array_int4

152+ , array_int4Oid

87 , array_regproc

153 , array_regproc

154+ , array_regprocOid

88 , array_text

155 , array_text

156+ , array_textOid

89 , array_tid

157 , array_tid

158+ , array_tidOid

90 , array_xid

159 , array_xid

160+ , array_xidOid

91 , array_cid

161 , array_cid

162+ , array_cidOid

92 , array_oidvector

163 , array_oidvector

164+ , array_oidvectorOid

93 , array_bpchar

165 , array_bpchar

166+ , array_bpcharOid

94 , array_varchar

167 , array_varchar

168+ , array_varcharOid

95 , array_int8

169 , array_int8

170+ , array_int8Oid

96 , array_point

171 , array_point

172+ , array_pointOid

97 , array_lseg

173 , array_lseg

174+ , array_lsegOid

98 , array_path

175 , array_path

176+ , array_pathOid

99 , array_box

177 , array_box

178+ , array_boxOid

100 , array_float4

179 , array_float4

180+ , array_float4Oid

101 , array_float8

181 , array_float8

182+ , array_float8Oid

102 , array_polygon

183 , array_polygon

184+ , array_polygonOid

103 , array_oid

185 , array_oid

186+ , array_oidOid

104 , array_macaddr

187 , array_macaddr

188+ , array_macaddrOid

105 , array_inet

189 , array_inet

190+ , array_inetOid

106 , array_timestamp

191 , array_timestamp

192+ , array_timestampOid

107 , array_date

193 , array_date

194+ , array_dateOid

108 , array_time

195 , array_time

196+ , array_timeOid

109 , array_timestamptz

197 , array_timestamptz

198+ , array_timestamptzOid

110 , array_interval

199 , array_interval

200+ , array_intervalOid

111 , array_numeric

201 , array_numeric

202+ , array_numericOid

112 , array_timetz

203 , array_timetz

204+ , array_timetzOid

113 , array_bit

205 , array_bit

206+ , array_bitOid

114 , array_varbit

207 , array_varbit

208+ , array_varbitOid

115 , array_refcursor

209 , array_refcursor

210+ , array_refcursorOid

116 , array_regprocedure

211 , array_regprocedure

212+ , array_regprocedureOid

117 , array_regoper

213 , array_regoper

214+ , array_regoperOid

118 , array_regoperator

215 , array_regoperator

216+ , array_regoperatorOid

119 , array_regclass

217 , array_regclass

218+ , array_regclassOid

120 , array_regtype

219 , array_regtype

220+ , array_regtypeOid

121 , array_uuid

221 , array_uuid

222+ , array_uuidOid

122 , array_jsonb

223 , array_jsonb

224+ , array_jsonbOid

123 , int4range

225 , int4range

226+ , int4rangeOid

124 , _int4range

227 , _int4range

228+ , _int4rangeOid

125 , numrange

229 , numrange

230+ , numrangeOid

126 , _numrange

231 , _numrange

232+ , _numrangeOid

127 , tsrange

233 , tsrange

234+ , tsrangeOid

128 , _tsrange

235 , _tsrange

236+ , _tsrangeOid

129 , tstzrange

237 , tstzrange

238+ , tstzrangeOid

130 , _tstzrange

239 , _tstzrange

240+ , _tstzrangeOid

131 , daterange

241 , daterange

242+ , daterangeOid

132 , _daterange

243 , _daterange

244+ , _daterangeOid

133 , int8range

245 , int8range

246+ , int8rangeOid

134 , _int8range

247 , _int8range

248+ , _int8rangeOid

135 ) where

249 ) where

136

250

137import Database.PostgreSQL.LibPQ (Oid(..))

251import Database.PostgreSQL.LibPQ (Oid(..))

@@ -257,976 +371,1432 @@ staticTypeInfo (Oid x) = case x of

257

371

258bool :: TypeInfo

372bool :: TypeInfo

259bool = Basic {

373bool = Basic {

260− typoid = Oid 16,

374+ typoid = boolOid,

261 typcategory = 'B',

375 typcategory = 'B',

262 typdelim = ',',

376 typdelim = ',',

263 typname = "bool"

377 typname = "bool"

264 }

378 }

265

379

380+boolOid :: Oid

381+boolOid = Oid 16

382+{-# INLINE boolOid #-}

383+

266bytea :: TypeInfo

384bytea :: TypeInfo

267bytea = Basic {

385bytea = Basic {

268− typoid = Oid 17,

386+ typoid = byteaOid,

269 typcategory = 'U',

387 typcategory = 'U',

270 typdelim = ',',

388 typdelim = ',',

271 typname = "bytea"

389 typname = "bytea"

272 }

390 }

273

391

392+byteaOid :: Oid

393+byteaOid = Oid 17

394+{-# INLINE byteaOid #-}

395+

274char :: TypeInfo

396char :: TypeInfo

275char = Basic {

397char = Basic {

276− typoid = Oid 18,

398+ typoid = charOid,

277 typcategory = 'S',

399 typcategory = 'S',

278 typdelim = ',',

400 typdelim = ',',

279 typname = "char"

401 typname = "char"

280 }

402 }

281

403

404+charOid :: Oid

405+charOid = Oid 18

406+{-# INLINE charOid #-}

407+

282name :: TypeInfo

408name :: TypeInfo

283name = Basic {

409name = Basic {

284− typoid = Oid 19,

410+ typoid = nameOid,

285 typcategory = 'S',

411 typcategory = 'S',

286 typdelim = ',',

412 typdelim = ',',

287 typname = "name"

413 typname = "name"

288 }

414 }

289

415

416+nameOid :: Oid

417+nameOid = Oid 19

418+{-# INLINE nameOid #-}

419+

290int8 :: TypeInfo

420int8 :: TypeInfo

291int8 = Basic {

421int8 = Basic {

292− typoid = Oid 20,

422+ typoid = int8Oid,

293 typcategory = 'N',

423 typcategory = 'N',

294 typdelim = ',',

424 typdelim = ',',

295 typname = "int8"

425 typname = "int8"

296 }

426 }

297

427

428+int8Oid :: Oid

429+int8Oid = Oid 20

430+{-# INLINE int8Oid #-}

431+

298int2 :: TypeInfo

432int2 :: TypeInfo

299int2 = Basic {

433int2 = Basic {

300− typoid = Oid 21,

434+ typoid = int2Oid,

301 typcategory = 'N',

435 typcategory = 'N',

302 typdelim = ',',

436 typdelim = ',',

303 typname = "int2"

437 typname = "int2"

304 }

438 }

305

439

440+int2Oid :: Oid

441+int2Oid = Oid 21

442+{-# INLINE int2Oid #-}

443+

306int4 :: TypeInfo

444int4 :: TypeInfo

307int4 = Basic {

445int4 = Basic {

308− typoid = Oid 23,

446+ typoid = int4Oid,

309 typcategory = 'N',

447 typcategory = 'N',

310 typdelim = ',',

448 typdelim = ',',

311 typname = "int4"

449 typname = "int4"

312 }

450 }

313

451

452+int4Oid :: Oid

453+int4Oid = Oid 23

454+{-# INLINE int4Oid #-}

455+

314regproc :: TypeInfo

456regproc :: TypeInfo

315regproc = Basic {

457regproc = Basic {

316− typoid = Oid 24,

458+ typoid = regprocOid,

317 typcategory = 'N',

459 typcategory = 'N',

318 typdelim = ',',

460 typdelim = ',',

319 typname = "regproc"

461 typname = "regproc"

320 }

462 }

321

463

464+regprocOid :: Oid

465+regprocOid = Oid 24

466+{-# INLINE regprocOid #-}

467+

322text :: TypeInfo

468text :: TypeInfo

323text = Basic {

469text = Basic {

324− typoid = Oid 25,

470+ typoid = textOid,

325 typcategory = 'S',

471 typcategory = 'S',

326 typdelim = ',',

472 typdelim = ',',

327 typname = "text"

473 typname = "text"

328 }

474 }

329

475

476+textOid :: Oid

477+textOid = Oid 25

478+{-# INLINE textOid #-}

479+

330oid :: TypeInfo

480oid :: TypeInfo

331oid = Basic {

481oid = Basic {

332− typoid = Oid 26,

482+ typoid = oidOid,

333 typcategory = 'N',

483 typcategory = 'N',

334 typdelim = ',',

484 typdelim = ',',

335 typname = "oid"

485 typname = "oid"

336 }

486 }

337

487

488+oidOid :: Oid

489+oidOid = Oid 26

490+{-# INLINE oidOid #-}

491+

338tid :: TypeInfo

492tid :: TypeInfo

339tid = Basic {

493tid = Basic {

340− typoid = Oid 27,

494+ typoid = tidOid,

341 typcategory = 'U',

495 typcategory = 'U',

342 typdelim = ',',

496 typdelim = ',',

343 typname = "tid"

497 typname = "tid"

344 }

498 }

345

499

500+tidOid :: Oid

501+tidOid = Oid 27

502+{-# INLINE tidOid #-}

503+

346xid :: TypeInfo

504xid :: TypeInfo

347xid = Basic {

505xid = Basic {

348− typoid = Oid 28,

506+ typoid = xidOid,

349 typcategory = 'U',

507 typcategory = 'U',

350 typdelim = ',',

508 typdelim = ',',

351 typname = "xid"

509 typname = "xid"

352 }

510 }

353

511

512+xidOid :: Oid

513+xidOid = Oid 28

514+{-# INLINE xidOid #-}

515+

354cid :: TypeInfo

516cid :: TypeInfo

355cid = Basic {

517cid = Basic {

356− typoid = Oid 29,

518+ typoid = cidOid,

357 typcategory = 'U',

519 typcategory = 'U',

358 typdelim = ',',

520 typdelim = ',',

359 typname = "cid"

521 typname = "cid"

360 }

522 }

361

523

524+cidOid :: Oid

525+cidOid = Oid 29

526+{-# INLINE cidOid #-}

527+

362xml :: TypeInfo

528xml :: TypeInfo

363xml = Basic {

529xml = Basic {

364− typoid = Oid 142,

530+ typoid = xmlOid,

365 typcategory = 'U',

531 typcategory = 'U',

366 typdelim = ',',

532 typdelim = ',',

367 typname = "xml"

533 typname = "xml"

368 }

534 }

369

535

536+xmlOid :: Oid

537+xmlOid = Oid 142

538+{-# INLINE xmlOid #-}

539+

370point :: TypeInfo

540point :: TypeInfo

371point = Basic {

541point = Basic {

372− typoid = Oid 600,

542+ typoid = pointOid,

373 typcategory = 'G',

543 typcategory = 'G',

374 typdelim = ',',

544 typdelim = ',',

375 typname = "point"

545 typname = "point"

376 }

546 }

377

547

548+pointOid :: Oid

549+pointOid = Oid 600

550+{-# INLINE pointOid #-}

551+

378lseg :: TypeInfo

552lseg :: TypeInfo

379lseg = Basic {

553lseg = Basic {

380− typoid = Oid 601,

554+ typoid = lsegOid,

381 typcategory = 'G',

555 typcategory = 'G',

382 typdelim = ',',

556 typdelim = ',',

383 typname = "lseg"

557 typname = "lseg"

384 }

558 }

385

559

560+lsegOid :: Oid

561+lsegOid = Oid 601

562+{-# INLINE lsegOid #-}

563+

386path :: TypeInfo

564path :: TypeInfo

387path = Basic {

565path = Basic {

388− typoid = Oid 602,

566+ typoid = pathOid,

389 typcategory = 'G',

567 typcategory = 'G',

390 typdelim = ',',

568 typdelim = ',',

391 typname = "path"

569 typname = "path"

392 }

570 }

393

571

572+pathOid :: Oid

573+pathOid = Oid 602

574+{-# INLINE pathOid #-}

575+

394box :: TypeInfo

576box :: TypeInfo

395box = Basic {

577box = Basic {

396− typoid = Oid 603,

578+ typoid = boxOid,

397 typcategory = 'G',

579 typcategory = 'G',

398 typdelim = ';',

580 typdelim = ';',

399 typname = "box"

581 typname = "box"

400 }

582 }

401

583

584+boxOid :: Oid

585+boxOid = Oid 603

586+{-# INLINE boxOid #-}

587+

402polygon :: TypeInfo

588polygon :: TypeInfo

403polygon = Basic {

589polygon = Basic {

404− typoid = Oid 604,

590+ typoid = polygonOid,

405 typcategory = 'G',

591 typcategory = 'G',

406 typdelim = ',',

592 typdelim = ',',

407 typname = "polygon"

593 typname = "polygon"

408 }

594 }

409

595

596+polygonOid :: Oid

597+polygonOid = Oid 604

598+{-# INLINE polygonOid #-}

599+

410line :: TypeInfo

600line :: TypeInfo

411line = Basic {

601line = Basic {

412− typoid = Oid 628,

602+ typoid = lineOid,

413 typcategory = 'G',

603 typcategory = 'G',

414 typdelim = ',',

604 typdelim = ',',

415 typname = "line"

605 typname = "line"

416 }

606 }

417

607

608+lineOid :: Oid

609+lineOid = Oid 628

610+{-# INLINE lineOid #-}

611+

418cidr :: TypeInfo

612cidr :: TypeInfo

419cidr = Basic {

613cidr = Basic {

420− typoid = Oid 650,

614+ typoid = cidrOid,

421 typcategory = 'I',

615 typcategory = 'I',

422 typdelim = ',',

616 typdelim = ',',

423 typname = "cidr"

617 typname = "cidr"

424 }

618 }

425

619

620+cidrOid :: Oid

621+cidrOid = Oid 650

622+{-# INLINE cidrOid #-}

623+

426float4 :: TypeInfo

624float4 :: TypeInfo

427float4 = Basic {

625float4 = Basic {

428− typoid = Oid 700,

626+ typoid = float4Oid,

429 typcategory = 'N',

627 typcategory = 'N',

430 typdelim = ',',

628 typdelim = ',',

431 typname = "float4"

629 typname = "float4"

432 }

630 }

433

631

632+float4Oid :: Oid

633+float4Oid = Oid 700

634+{-# INLINE float4Oid #-}

635+

434float8 :: TypeInfo

636float8 :: TypeInfo

435float8 = Basic {

637float8 = Basic {

436− typoid = Oid 701,

638+ typoid = float8Oid,

437 typcategory = 'N',

639 typcategory = 'N',

438 typdelim = ',',

640 typdelim = ',',

439 typname = "float8"

641 typname = "float8"

440 }

642 }

441

643

644+float8Oid :: Oid

645+float8Oid = Oid 701

646+{-# INLINE float8Oid #-}

647+

442unknown :: TypeInfo

648unknown :: TypeInfo

443unknown = Basic {

649unknown = Basic {

444− typoid = Oid 705,

650+ typoid = unknownOid,

445 typcategory = 'X',

651 typcategory = 'X',

446 typdelim = ',',

652 typdelim = ',',

447 typname = "unknown"

653 typname = "unknown"

448 }

654 }

449

655

656+unknownOid :: Oid

657+unknownOid = Oid 705

658+{-# INLINE unknownOid #-}

659+

450circle :: TypeInfo

660circle :: TypeInfo

451circle = Basic {

661circle = Basic {

452− typoid = Oid 718,

662+ typoid = circleOid,

453 typcategory = 'G',

663 typcategory = 'G',

454 typdelim = ',',

664 typdelim = ',',

455 typname = "circle"

665 typname = "circle"

456 }

666 }

457

667

668+circleOid :: Oid

669+circleOid = Oid 718

670+{-# INLINE circleOid #-}

671+

458money :: TypeInfo

672money :: TypeInfo

459money = Basic {

673money = Basic {

460− typoid = Oid 790,

674+ typoid = moneyOid,

461 typcategory = 'N',

675 typcategory = 'N',

462 typdelim = ',',

676 typdelim = ',',

463 typname = "money"

677 typname = "money"

464 }

678 }

465

679

680+moneyOid :: Oid

681+moneyOid = Oid 790

682+{-# INLINE moneyOid #-}

683+

466macaddr :: TypeInfo

684macaddr :: TypeInfo

467macaddr = Basic {

685macaddr = Basic {

468− typoid = Oid 829,

686+ typoid = macaddrOid,

469 typcategory = 'U',

687 typcategory = 'U',

470 typdelim = ',',

688 typdelim = ',',

471 typname = "macaddr"

689 typname = "macaddr"

472 }

690 }

473

691

692+macaddrOid :: Oid

693+macaddrOid = Oid 829

694+{-# INLINE macaddrOid #-}

695+

474inet :: TypeInfo

696inet :: TypeInfo

475inet = Basic {

697inet = Basic {

476− typoid = Oid 869,

698+ typoid = inetOid,

477 typcategory = 'I',

699 typcategory = 'I',

478 typdelim = ',',

700 typdelim = ',',

479 typname = "inet"

701 typname = "inet"

480 }

702 }

481

703

704+inetOid :: Oid

705+inetOid = Oid 869

706+{-# INLINE inetOid #-}

707+

482bpchar :: TypeInfo

708bpchar :: TypeInfo

483bpchar = Basic {

709bpchar = Basic {

484− typoid = Oid 1042,

710+ typoid = bpcharOid,

485 typcategory = 'S',

711 typcategory = 'S',

486 typdelim = ',',

712 typdelim = ',',

487 typname = "bpchar"

713 typname = "bpchar"

488 }

714 }

489

715

716+bpcharOid :: Oid

717+bpcharOid = Oid 1042

718+{-# INLINE bpcharOid #-}

719+

490varchar :: TypeInfo

720varchar :: TypeInfo

491varchar = Basic {

721varchar = Basic {

492− typoid = Oid 1043,

722+ typoid = varcharOid,

493 typcategory = 'S',

723 typcategory = 'S',

494 typdelim = ',',

724 typdelim = ',',

495 typname = "varchar"

725 typname = "varchar"

496 }

726 }

497

727

728+varcharOid :: Oid

729+varcharOid = Oid 1043

730+{-# INLINE varcharOid #-}

731+

498date :: TypeInfo

732date :: TypeInfo

499date = Basic {

733date = Basic {

500− typoid = Oid 1082,

734+ typoid = dateOid,

501 typcategory = 'D',

735 typcategory = 'D',

502 typdelim = ',',

736 typdelim = ',',

503 typname = "date"

737 typname = "date"

504 }

738 }

505

739

740+dateOid :: Oid

741+dateOid = Oid 1082

742+{-# INLINE dateOid #-}

743+

506time :: TypeInfo

744time :: TypeInfo

507time = Basic {

745time = Basic {

508− typoid = Oid 1083,

746+ typoid = timeOid,

509 typcategory = 'D',

747 typcategory = 'D',

510 typdelim = ',',

748 typdelim = ',',

511 typname = "time"

749 typname = "time"

512 }

750 }

513

751

752+timeOid :: Oid

753+timeOid = Oid 1083

754+{-# INLINE timeOid #-}

755+

514timestamp :: TypeInfo

756timestamp :: TypeInfo

515timestamp = Basic {

757timestamp = Basic {

516− typoid = Oid 1114,

758+ typoid = timestampOid,

517 typcategory = 'D',

759 typcategory = 'D',

518 typdelim = ',',

760 typdelim = ',',

519 typname = "timestamp"

761 typname = "timestamp"

520 }

762 }

521

763

764+timestampOid :: Oid

765+timestampOid = Oid 1114

766+{-# INLINE timestampOid #-}

767+

522timestamptz :: TypeInfo

768timestamptz :: TypeInfo

523timestamptz = Basic {

769timestamptz = Basic {

524− typoid = Oid 1184,

770+ typoid = timestamptzOid,

525 typcategory = 'D',

771 typcategory = 'D',

526 typdelim = ',',

772 typdelim = ',',

527 typname = "timestamptz"

773 typname = "timestamptz"

528 }

774 }

529

775

776+timestamptzOid :: Oid

777+timestamptzOid = Oid 1184

778+{-# INLINE timestamptzOid #-}

779+

530interval :: TypeInfo

780interval :: TypeInfo

531interval = Basic {

781interval = Basic {

532− typoid = Oid 1186,

782+ typoid = intervalOid,

533 typcategory = 'T',

783 typcategory = 'T',

534 typdelim = ',',

784 typdelim = ',',

535 typname = "interval"

785 typname = "interval"

536 }

786 }

537

787

788+intervalOid :: Oid

789+intervalOid = Oid 1186

790+{-# INLINE intervalOid #-}

791+

538timetz :: TypeInfo

792timetz :: TypeInfo

539timetz = Basic {

793timetz = Basic {

540− typoid = Oid 1266,

794+ typoid = timetzOid,

541 typcategory = 'D',

795 typcategory = 'D',

542 typdelim = ',',

796 typdelim = ',',

543 typname = "timetz"

797 typname = "timetz"

544 }

798 }

545

799

800+timetzOid :: Oid

801+timetzOid = Oid 1266

802+{-# INLINE timetzOid #-}

803+

546bit :: TypeInfo

804bit :: TypeInfo

547bit = Basic {

805bit = Basic {

548− typoid = Oid 1560,

806+ typoid = bitOid,

549 typcategory = 'V',

807 typcategory = 'V',

550 typdelim = ',',

808 typdelim = ',',

551 typname = "bit"

809 typname = "bit"

552 }

810 }

553

811

812+bitOid :: Oid

813+bitOid = Oid 1560

814+{-# INLINE bitOid #-}

815+

554varbit :: TypeInfo

816varbit :: TypeInfo

555varbit = Basic {

817varbit = Basic {

556− typoid = Oid 1562,

818+ typoid = varbitOid,

557 typcategory = 'V',

819 typcategory = 'V',

558 typdelim = ',',

820 typdelim = ',',

559 typname = "varbit"

821 typname = "varbit"

560 }

822 }

561

823

824+varbitOid :: Oid

825+varbitOid = Oid 1562

826+{-# INLINE varbitOid #-}

827+

562numeric :: TypeInfo

828numeric :: TypeInfo

563numeric = Basic {

829numeric = Basic {

564− typoid = Oid 1700,

830+ typoid = numericOid,

565 typcategory = 'N',

831 typcategory = 'N',

566 typdelim = ',',

832 typdelim = ',',

567 typname = "numeric"

833 typname = "numeric"

568 }

834 }

569

835

836+numericOid :: Oid

837+numericOid = Oid 1700

838+{-# INLINE numericOid #-}

839+

570refcursor :: TypeInfo

840refcursor :: TypeInfo

571refcursor = Basic {

841refcursor = Basic {

572− typoid = Oid 1790,

842+ typoid = refcursorOid,

573 typcategory = 'U',

843 typcategory = 'U',

574 typdelim = ',',

844 typdelim = ',',

575 typname = "refcursor"

845 typname = "refcursor"

576 }

846 }

577

847

848+refcursorOid :: Oid

849+refcursorOid = Oid 1790

850+{-# INLINE refcursorOid #-}

851+

578record :: TypeInfo

852record :: TypeInfo

579record = Basic {

853record = Basic {

580− typoid = Oid 2249,

854+ typoid = recordOid,

581 typcategory = 'P',

855 typcategory = 'P',

582 typdelim = ',',

856 typdelim = ',',

583 typname = "record"

857 typname = "record"

584 }

858 }

585

859

860+recordOid :: Oid

861+recordOid = Oid 2249

862+{-# INLINE recordOid #-}

863+

586void :: TypeInfo

864void :: TypeInfo

587void = Basic {

865void = Basic {

588− typoid = Oid 2278,

866+ typoid = voidOid,

589 typcategory = 'P',

867 typcategory = 'P',

590 typdelim = ',',

868 typdelim = ',',

591 typname = "void"

869 typname = "void"

592 }

870 }

593

871

872+voidOid :: Oid

873+voidOid = Oid 2278

874+{-# INLINE voidOid #-}

875+

594array_record :: TypeInfo

876array_record :: TypeInfo

595array_record = Array {

877array_record = Array {

596− typoid = Oid 2287,

878+ typoid = array_recordOid,

597 typcategory = 'P',

879 typcategory = 'P',

598 typdelim = ',',

880 typdelim = ',',

599 typname = "_record",

881 typname = "_record",

600 typelem = record

882 typelem = record

601 }

883 }

602

884

885+array_recordOid :: Oid

886+array_recordOid = Oid 2287

887+{-# INLINE array_recordOid #-}

888+

603regprocedure :: TypeInfo

889regprocedure :: TypeInfo

604regprocedure = Basic {

890regprocedure = Basic {

605− typoid = Oid 2202,

891+ typoid = regprocedureOid,

606 typcategory = 'N',

892 typcategory = 'N',

607 typdelim = ',',

893 typdelim = ',',

608 typname = "regprocedure"

894 typname = "regprocedure"

609 }

895 }

610

896

897+regprocedureOid :: Oid

898+regprocedureOid = Oid 2202

899+{-# INLINE regprocedureOid #-}

900+

611regoper :: TypeInfo

901regoper :: TypeInfo

612regoper = Basic {

902regoper = Basic {

613− typoid = Oid 2203,

903+ typoid = regoperOid,

614 typcategory = 'N',

904 typcategory = 'N',

615 typdelim = ',',

905 typdelim = ',',

616 typname = "regoper"

906 typname = "regoper"

617 }

907 }

618

908

909+regoperOid :: Oid

910+regoperOid = Oid 2203

911+{-# INLINE regoperOid #-}

912+

619regoperator :: TypeInfo

913regoperator :: TypeInfo

620regoperator = Basic {

914regoperator = Basic {

621− typoid = Oid 2204,

915+ typoid = regoperatorOid,

622 typcategory = 'N',

916 typcategory = 'N',

623 typdelim = ',',

917 typdelim = ',',

624 typname = "regoperator"

918 typname = "regoperator"

625 }

919 }

626

920

921+regoperatorOid :: Oid

922+regoperatorOid = Oid 2204

923+{-# INLINE regoperatorOid #-}

924+

627regclass :: TypeInfo

925regclass :: TypeInfo

628regclass = Basic {

926regclass = Basic {

629− typoid = Oid 2205,

927+ typoid = regclassOid,

630 typcategory = 'N',

928 typcategory = 'N',

631 typdelim = ',',

929 typdelim = ',',

632 typname = "regclass"

930 typname = "regclass"

633 }

931 }

634

932

933+regclassOid :: Oid

934+regclassOid = Oid 2205

935+{-# INLINE regclassOid #-}

936+

635regtype :: TypeInfo

937regtype :: TypeInfo

636regtype = Basic {

938regtype = Basic {

637− typoid = Oid 2206,

939+ typoid = regtypeOid,

638 typcategory = 'N',

940 typcategory = 'N',

639 typdelim = ',',

941 typdelim = ',',

640 typname = "regtype"

942 typname = "regtype"

641 }

943 }

642

944

945+regtypeOid :: Oid

946+regtypeOid = Oid 2206

947+{-# INLINE regtypeOid #-}

948+

643uuid :: TypeInfo

949uuid :: TypeInfo

644uuid = Basic {

950uuid = Basic {

645− typoid = Oid 2950,

951+ typoid = uuidOid,

646 typcategory = 'U',

952 typcategory = 'U',

647 typdelim = ',',

953 typdelim = ',',

648 typname = "uuid"

954 typname = "uuid"

649 }

955 }

650

956

957+uuidOid :: Oid

958+uuidOid = Oid 2950

959+{-# INLINE uuidOid #-}

960+

651json :: TypeInfo

961json :: TypeInfo

652json = Basic {

962json = Basic {

653− typoid = Oid 114,

963+ typoid = jsonOid,

654 typcategory = 'U',

964 typcategory = 'U',

655 typdelim = ',',

965 typdelim = ',',

656 typname = "json"

966 typname = "json"

657 }

967 }

658

968

969+jsonOid :: Oid

970+jsonOid = Oid 114

971+{-# INLINE jsonOid #-}

972+

659jsonb :: TypeInfo

973jsonb :: TypeInfo

660jsonb = Basic {

974jsonb = Basic {

661− typoid = Oid 3802,

975+ typoid = jsonbOid,

662 typcategory = 'U',

976 typcategory = 'U',

663 typdelim = ',',

977 typdelim = ',',

664 typname = "jsonb"

978 typname = "jsonb"

665 }

979 }

666

980

981+jsonbOid :: Oid

982+jsonbOid = Oid 3802

983+{-# INLINE jsonbOid #-}

984+

667int2vector :: TypeInfo

985int2vector :: TypeInfo

668int2vector = Array {

986int2vector = Array {

669− typoid = Oid 22,

987+ typoid = int2vectorOid,

670 typcategory = 'A',

988 typcategory = 'A',

671 typdelim = ',',

989 typdelim = ',',

672 typname = "int2vector",

990 typname = "int2vector",

673 typelem = int2

991 typelem = int2

674 }

992 }

675

993

994+int2vectorOid :: Oid

995+int2vectorOid = Oid 22

996+{-# INLINE int2vectorOid #-}

997+

676oidvector :: TypeInfo

998oidvector :: TypeInfo

677oidvector = Array {

999oidvector = Array {

678− typoid = Oid 30,

1000+ typoid = oidvectorOid,

679 typcategory = 'A',

1001 typcategory = 'A',

680 typdelim = ',',

1002 typdelim = ',',

681 typname = "oidvector",

1003 typname = "oidvector",

682 typelem = oid

1004 typelem = oid

683 }

1005 }

684

1006

1007+oidvectorOid :: Oid

1008+oidvectorOid = Oid 30

1009+{-# INLINE oidvectorOid #-}

1010+

685array_xml :: TypeInfo

1011array_xml :: TypeInfo

686array_xml = Array {

1012array_xml = Array {

687− typoid = Oid 143,

1013+ typoid = array_xmlOid,

688 typcategory = 'A',

1014 typcategory = 'A',

689 typdelim = ',',

1015 typdelim = ',',

690 typname = "_xml",

1016 typname = "_xml",

691 typelem = xml

1017 typelem = xml

692 }

1018 }

693

1019

1020+array_xmlOid :: Oid

1021+array_xmlOid = Oid 143

1022+{-# INLINE array_xmlOid #-}

1023+

694array_json :: TypeInfo

1024array_json :: TypeInfo

695array_json = Array {

1025array_json = Array {

696− typoid = Oid 199,

1026+ typoid = array_jsonOid,

697 typcategory = 'A',

1027 typcategory = 'A',

698 typdelim = ',',

1028 typdelim = ',',

699 typname = "_json",

1029 typname = "_json",

700 typelem = json

1030 typelem = json

701 }

1031 }

702

1032

1033+array_jsonOid :: Oid

1034+array_jsonOid = Oid 199

1035+{-# INLINE array_jsonOid #-}

1036+

703array_line :: TypeInfo

1037array_line :: TypeInfo

704array_line = Array {

1038array_line = Array {

705− typoid = Oid 629,

1039+ typoid = array_lineOid,

706 typcategory = 'A',

1040 typcategory = 'A',

707 typdelim = ',',

1041 typdelim = ',',

708 typname = "_line",

1042 typname = "_line",

709 typelem = line

1043 typelem = line

710 }

1044 }

711

1045

1046+array_lineOid :: Oid

1047+array_lineOid = Oid 629

1048+{-# INLINE array_lineOid #-}

1049+

712array_cidr :: TypeInfo

1050array_cidr :: TypeInfo

713array_cidr = Array {

1051array_cidr = Array {

714− typoid = Oid 651,

1052+ typoid = array_cidrOid,

715 typcategory = 'A',

1053 typcategory = 'A',

716 typdelim = ',',

1054 typdelim = ',',

717 typname = "_cidr",

1055 typname = "_cidr",

718 typelem = cidr

1056 typelem = cidr

719 }

1057 }

720

1058

1059+array_cidrOid :: Oid

1060+array_cidrOid = Oid 651

1061+{-# INLINE array_cidrOid #-}

1062+

721array_circle :: TypeInfo

1063array_circle :: TypeInfo

722array_circle = Array {

1064array_circle = Array {

723− typoid = Oid 719,

1065+ typoid = array_circleOid,

724 typcategory = 'A',

1066 typcategory = 'A',

725 typdelim = ',',

1067 typdelim = ',',

726 typname = "_circle",

1068 typname = "_circle",

727 typelem = circle

1069 typelem = circle

728 }

1070 }

729

1071

1072+array_circleOid :: Oid

1073+array_circleOid = Oid 719

1074+{-# INLINE array_circleOid #-}

1075+

730array_money :: TypeInfo

1076array_money :: TypeInfo

731array_money = Array {

1077array_money = Array {

732− typoid = Oid 791,

1078+ typoid = array_moneyOid,

733 typcategory = 'A',

1079 typcategory = 'A',

734 typdelim = ',',

1080 typdelim = ',',

735 typname = "_money",

1081 typname = "_money",

736 typelem = money

1082 typelem = money

737 }

1083 }

738

1084

1085+array_moneyOid :: Oid

1086+array_moneyOid = Oid 791

1087+{-# INLINE array_moneyOid #-}

1088+

739array_bool :: TypeInfo

1089array_bool :: TypeInfo

740array_bool = Array {

1090array_bool = Array {

741− typoid = Oid 1000,

1091+ typoid = array_boolOid,

742 typcategory = 'A',

1092 typcategory = 'A',

743 typdelim = ',',

1093 typdelim = ',',

744 typname = "_bool",

1094 typname = "_bool",

745 typelem = bool

1095 typelem = bool

746 }

1096 }

747

1097

1098+array_boolOid :: Oid

1099+array_boolOid = Oid 1000

1100+{-# INLINE array_boolOid #-}

1101+

748array_bytea :: TypeInfo

1102array_bytea :: TypeInfo

749array_bytea = Array {

1103array_bytea = Array {

750− typoid = Oid 1001,

1104+ typoid = array_byteaOid,

751 typcategory = 'A',

1105 typcategory = 'A',

752 typdelim = ',',

1106 typdelim = ',',

753 typname = "_bytea",

1107 typname = "_bytea",

754 typelem = bytea

1108 typelem = bytea

755 }

1109 }

756

1110

1111+array_byteaOid :: Oid

1112+array_byteaOid = Oid 1001

1113+{-# INLINE array_byteaOid #-}

1114+

757array_char :: TypeInfo

1115array_char :: TypeInfo

758array_char = Array {

1116array_char = Array {

759− typoid = Oid 1002,

1117+ typoid = array_charOid,

760 typcategory = 'A',

1118 typcategory = 'A',

761 typdelim = ',',

1119 typdelim = ',',

762 typname = "_char",

1120 typname = "_char",

763 typelem = char

1121 typelem = char

764 }

1122 }

765

1123

1124+array_charOid :: Oid

1125+array_charOid = Oid 1002

1126+{-# INLINE array_charOid #-}

1127+

766array_name :: TypeInfo

1128array_name :: TypeInfo

767array_name = Array {

1129array_name = Array {

768− typoid = Oid 1003,

1130+ typoid = array_nameOid,

769 typcategory = 'A',

1131 typcategory = 'A',

770 typdelim = ',',

1132 typdelim = ',',

771 typname = "_name",

1133 typname = "_name",

772 typelem = name

1134 typelem = name

773 }

1135 }

774

1136

1137+array_nameOid :: Oid

1138+array_nameOid = Oid 1003

1139+{-# INLINE array_nameOid #-}

1140+

775array_int2 :: TypeInfo

1141array_int2 :: TypeInfo

776array_int2 = Array {

1142array_int2 = Array {

777− typoid = Oid 1005,

1143+ typoid = array_int2Oid,

778 typcategory = 'A',

1144 typcategory = 'A',

779 typdelim = ',',

1145 typdelim = ',',

780 typname = "_int2",

1146 typname = "_int2",

781 typelem = int2

1147 typelem = int2

782 }

1148 }

783

1149

1150+array_int2Oid :: Oid

1151+array_int2Oid = Oid 1005

1152+{-# INLINE array_int2Oid #-}

1153+

784array_int2vector :: TypeInfo

1154array_int2vector :: TypeInfo

785array_int2vector = Array {

1155array_int2vector = Array {

786− typoid = Oid 1006,

1156+ typoid = array_int2vectorOid,

787 typcategory = 'A',

1157 typcategory = 'A',

788 typdelim = ',',

1158 typdelim = ',',

789 typname = "_int2vector",

1159 typname = "_int2vector",

790 typelem = int2vector

1160 typelem = int2vector

791 }

1161 }

792

1162

1163+array_int2vectorOid :: Oid

1164+array_int2vectorOid = Oid 1006

1165+{-# INLINE array_int2vectorOid #-}

1166+

793array_int4 :: TypeInfo

1167array_int4 :: TypeInfo

794array_int4 = Array {

1168array_int4 = Array {

795− typoid = Oid 1007,

1169+ typoid = array_int4Oid,

796 typcategory = 'A',

1170 typcategory = 'A',

797 typdelim = ',',

1171 typdelim = ',',

798 typname = "_int4",

1172 typname = "_int4",

799 typelem = int4

1173 typelem = int4

800 }

1174 }

801

1175

1176+array_int4Oid :: Oid

1177+array_int4Oid = Oid 1007

1178+{-# INLINE array_int4Oid #-}

1179+

802array_regproc :: TypeInfo

1180array_regproc :: TypeInfo

803array_regproc = Array {

1181array_regproc = Array {

804− typoid = Oid 1008,

1182+ typoid = array_regprocOid,

805 typcategory = 'A',

1183 typcategory = 'A',

806 typdelim = ',',

1184 typdelim = ',',

807 typname = "_regproc",

1185 typname = "_regproc",

808 typelem = regproc

1186 typelem = regproc

809 }

1187 }

810

1188

1189+array_regprocOid :: Oid

1190+array_regprocOid = Oid 1008

1191+{-# INLINE array_regprocOid #-}

1192+

811array_text :: TypeInfo

1193array_text :: TypeInfo

812array_text = Array {

1194array_text = Array {

813− typoid = Oid 1009,

1195+ typoid = array_textOid,

814 typcategory = 'A',

1196 typcategory = 'A',

815 typdelim = ',',

1197 typdelim = ',',

816 typname = "_text",

1198 typname = "_text",

817 typelem = text

1199 typelem = text

818 }

1200 }

819

1201

1202+array_textOid :: Oid

1203+array_textOid = Oid 1009

1204+{-# INLINE array_textOid #-}

1205+

820array_tid :: TypeInfo

1206array_tid :: TypeInfo

821array_tid = Array {

1207array_tid = Array {

822− typoid = Oid 1010,

1208+ typoid = array_tidOid,

823 typcategory = 'A',

1209 typcategory = 'A',

824 typdelim = ',',

1210 typdelim = ',',

825 typname = "_tid",

1211 typname = "_tid",

826 typelem = tid

1212 typelem = tid

827 }

1213 }

828

1214

1215+array_tidOid :: Oid

1216+array_tidOid = Oid 1010

1217+{-# INLINE array_tidOid #-}

1218+

829array_xid :: TypeInfo

1219array_xid :: TypeInfo

830array_xid = Array {

1220array_xid = Array {

831− typoid = Oid 1011,

1221+ typoid = array_xidOid,

832 typcategory = 'A',

1222 typcategory = 'A',

833 typdelim = ',',

1223 typdelim = ',',

834 typname = "_xid",

1224 typname = "_xid",

835 typelem = xid

1225 typelem = xid

836 }

1226 }

837

1227

1228+array_xidOid :: Oid

1229+array_xidOid = Oid 1011

1230+{-# INLINE array_xidOid #-}

1231+

838array_cid :: TypeInfo

1232array_cid :: TypeInfo

839array_cid = Array {

1233array_cid = Array {

840− typoid = Oid 1012,

1234+ typoid = array_cidOid,

841 typcategory = 'A',

1235 typcategory = 'A',

842 typdelim = ',',

1236 typdelim = ',',

843 typname = "_cid",

1237 typname = "_cid",

844 typelem = cid

1238 typelem = cid

845 }

1239 }

846

1240

1241+array_cidOid :: Oid

1242+array_cidOid = Oid 1012

1243+{-# INLINE array_cidOid #-}

1244+

847array_oidvector :: TypeInfo

1245array_oidvector :: TypeInfo

848array_oidvector = Array {

1246array_oidvector = Array {

849− typoid = Oid 1013,

1247+ typoid = array_oidvectorOid,

850 typcategory = 'A',

1248 typcategory = 'A',

851 typdelim = ',',

1249 typdelim = ',',

852 typname = "_oidvector",

1250 typname = "_oidvector",

853 typelem = oidvector

1251 typelem = oidvector

854 }

1252 }

855

1253

1254+array_oidvectorOid :: Oid

1255+array_oidvectorOid = Oid 1013

1256+{-# INLINE array_oidvectorOid #-}

1257+

856array_bpchar :: TypeInfo

1258array_bpchar :: TypeInfo

857array_bpchar = Array {

1259array_bpchar = Array {

858− typoid = Oid 1014,

1260+ typoid = array_bpcharOid,

859 typcategory = 'A',

1261 typcategory = 'A',

860 typdelim = ',',

1262 typdelim = ',',

861 typname = "_bpchar",

1263 typname = "_bpchar",

862 typelem = bpchar

1264 typelem = bpchar

863 }

1265 }

864

1266

1267+array_bpcharOid :: Oid

1268+array_bpcharOid = Oid 1014

1269+{-# INLINE array_bpcharOid #-}

1270+

865array_varchar :: TypeInfo

1271array_varchar :: TypeInfo

866array_varchar = Array {

1272array_varchar = Array {

867− typoid = Oid 1015,

1273+ typoid = array_varcharOid,

868 typcategory = 'A',

1274 typcategory = 'A',

869 typdelim = ',',

1275 typdelim = ',',

870 typname = "_varchar",

1276 typname = "_varchar",

871 typelem = varchar

1277 typelem = varchar

872 }

1278 }

873

1279

1280+array_varcharOid :: Oid

1281+array_varcharOid = Oid 1015

1282+{-# INLINE array_varcharOid #-}

1283+

874array_int8 :: TypeInfo

1284array_int8 :: TypeInfo

875array_int8 = Array {

1285array_int8 = Array {

876− typoid = Oid 1016,

1286+ typoid = array_int8Oid,

877 typcategory = 'A',

1287 typcategory = 'A',

878 typdelim = ',',

1288 typdelim = ',',

879 typname = "_int8",

1289 typname = "_int8",

880 typelem = int8

1290 typelem = int8

881 }

1291 }

882

1292

1293+array_int8Oid :: Oid

1294+array_int8Oid = Oid 1016

1295+{-# INLINE array_int8Oid #-}

1296+

883array_point :: TypeInfo

1297array_point :: TypeInfo

884array_point = Array {

1298array_point = Array {

885− typoid = Oid 1017,

1299+ typoid = array_pointOid,

886 typcategory = 'A',

1300 typcategory = 'A',

887 typdelim = ',',

1301 typdelim = ',',

888 typname = "_point",

1302 typname = "_point",

889 typelem = point

1303 typelem = point

890 }

1304 }

891

1305

1306+array_pointOid :: Oid

1307+array_pointOid = Oid 1017

1308+{-# INLINE array_pointOid #-}

1309+

892array_lseg :: TypeInfo

1310array_lseg :: TypeInfo

893array_lseg = Array {

1311array_lseg = Array {

894− typoid = Oid 1018,

1312+ typoid = array_lsegOid,

895 typcategory = 'A',

1313 typcategory = 'A',

896 typdelim = ',',

1314 typdelim = ',',

897 typname = "_lseg",

1315 typname = "_lseg",

898 typelem = lseg

1316 typelem = lseg

899 }

1317 }

900

1318

1319+array_lsegOid :: Oid

1320+array_lsegOid = Oid 1018

1321+{-# INLINE array_lsegOid #-}

1322+

901array_path :: TypeInfo

1323array_path :: TypeInfo

902array_path = Array {

1324array_path = Array {

903− typoid = Oid 1019,

1325+ typoid = array_pathOid,

904 typcategory = 'A',

1326 typcategory = 'A',

905 typdelim = ',',

1327 typdelim = ',',

906 typname = "_path",

1328 typname = "_path",

907 typelem = path

1329 typelem = path

908 }

1330 }

909

1331

1332+array_pathOid :: Oid

1333+array_pathOid = Oid 1019

1334+{-# INLINE array_pathOid #-}

1335+

910array_box :: TypeInfo

1336array_box :: TypeInfo

911array_box = Array {

1337array_box = Array {

912− typoid = Oid 1020,

1338+ typoid = array_boxOid,

913 typcategory = 'A',

1339 typcategory = 'A',

914 typdelim = ';',

1340 typdelim = ';',

915 typname = "_box",

1341 typname = "_box",

916 typelem = box

1342 typelem = box

917 }

1343 }

918

1344

1345+array_boxOid :: Oid

1346+array_boxOid = Oid 1020

1347+{-# INLINE array_boxOid #-}

1348+

919array_float4 :: TypeInfo

1349array_float4 :: TypeInfo

920array_float4 = Array {

1350array_float4 = Array {

921− typoid = Oid 1021,

1351+ typoid = array_float4Oid,

922 typcategory = 'A',

1352 typcategory = 'A',

923 typdelim = ',',

1353 typdelim = ',',

924 typname = "_float4",

1354 typname = "_float4",

925 typelem = float4

1355 typelem = float4

926 }

1356 }

927

1357

1358+array_float4Oid :: Oid

1359+array_float4Oid = Oid 1021

1360+{-# INLINE array_float4Oid #-}

1361+

928array_float8 :: TypeInfo

1362array_float8 :: TypeInfo

929array_float8 = Array {

1363array_float8 = Array {

930− typoid = Oid 1022,

1364+ typoid = array_float8Oid,

931 typcategory = 'A',

1365 typcategory = 'A',

932 typdelim = ',',

1366 typdelim = ',',

933 typname = "_float8",

1367 typname = "_float8",

934 typelem = float8

1368 typelem = float8

935 }

1369 }

936

1370

1371+array_float8Oid :: Oid

1372+array_float8Oid = Oid 1022

1373+{-# INLINE array_float8Oid #-}

1374+

937array_polygon :: TypeInfo

1375array_polygon :: TypeInfo

938array_polygon = Array {

1376array_polygon = Array {

939− typoid = Oid 1027,

1377+ typoid = array_polygonOid,

940 typcategory = 'A',

1378 typcategory = 'A',

941 typdelim = ',',

1379 typdelim = ',',

942 typname = "_polygon",

1380 typname = "_polygon",

943 typelem = polygon

1381 typelem = polygon

944 }

1382 }

945

1383

1384+array_polygonOid :: Oid

1385+array_polygonOid = Oid 1027

1386+{-# INLINE array_polygonOid #-}

1387+

946array_oid :: TypeInfo

1388array_oid :: TypeInfo

947array_oid = Array {

1389array_oid = Array {

948− typoid = Oid 1028,

1390+ typoid = array_oidOid,

949 typcategory = 'A',

1391 typcategory = 'A',

950 typdelim = ',',

1392 typdelim = ',',

951 typname = "_oid",

1393 typname = "_oid",

952 typelem = oid

1394 typelem = oid

953 }

1395 }

954

1396

1397+array_oidOid :: Oid

1398+array_oidOid = Oid 1028

1399+{-# INLINE array_oidOid #-}

1400+

955array_macaddr :: TypeInfo

1401array_macaddr :: TypeInfo

956array_macaddr = Array {

1402array_macaddr = Array {

957− typoid = Oid 1040,

1403+ typoid = array_macaddrOid,

958 typcategory = 'A',

1404 typcategory = 'A',

959 typdelim = ',',

1405 typdelim = ',',

960 typname = "_macaddr",

1406 typname = "_macaddr",

961 typelem = macaddr

1407 typelem = macaddr

962 }

1408 }

963

1409

1410+array_macaddrOid :: Oid

1411+array_macaddrOid = Oid 1040

1412+{-# INLINE array_macaddrOid #-}

1413+

964array_inet :: TypeInfo

1414array_inet :: TypeInfo

965array_inet = Array {

1415array_inet = Array {

966− typoid = Oid 1041,

1416+ typoid = array_inetOid,

967 typcategory = 'A',

1417 typcategory = 'A',

968 typdelim = ',',

1418 typdelim = ',',

969 typname = "_inet",

1419 typname = "_inet",

970 typelem = inet

1420 typelem = inet

971 }

1421 }

972

1422

1423+array_inetOid :: Oid

1424+array_inetOid = Oid 1041

1425+{-# INLINE array_inetOid #-}

1426+

973array_timestamp :: TypeInfo

1427array_timestamp :: TypeInfo

974array_timestamp = Array {

1428array_timestamp = Array {

975− typoid = Oid 1115,

1429+ typoid = array_timestampOid,

976 typcategory = 'A',

1430 typcategory = 'A',

977 typdelim = ',',

1431 typdelim = ',',

978 typname = "_timestamp",

1432 typname = "_timestamp",

979 typelem = timestamp

1433 typelem = timestamp

980 }

1434 }

981

1435

1436+array_timestampOid :: Oid

1437+array_timestampOid = Oid 1115

1438+{-# INLINE array_timestampOid #-}

1439+

982array_date :: TypeInfo

1440array_date :: TypeInfo

983array_date = Array {

1441array_date = Array {

984− typoid = Oid 1182,

1442+ typoid = array_dateOid,

985 typcategory = 'A',

1443 typcategory = 'A',

986 typdelim = ',',

1444 typdelim = ',',

987 typname = "_date",

1445 typname = "_date",

988 typelem = date

1446 typelem = date

989 }

1447 }

990

1448

1449+array_dateOid :: Oid

1450+array_dateOid = Oid 1182

1451+{-# INLINE array_dateOid #-}

1452+

991array_time :: TypeInfo

1453array_time :: TypeInfo

992array_time = Array {

1454array_time = Array {

993− typoid = Oid 1183,

1455+ typoid = array_timeOid,

994 typcategory = 'A',

1456 typcategory = 'A',

995 typdelim = ',',

1457 typdelim = ',',

996 typname = "_time",

1458 typname = "_time",

997 typelem = time

1459 typelem = time

998 }

1460 }

999

1461

1462+array_timeOid :: Oid

1463+array_timeOid = Oid 1183

1464+{-# INLINE array_timeOid #-}

1465+

1000array_timestamptz :: TypeInfo

1466array_timestamptz :: TypeInfo

1001array_timestamptz = Array {

1467array_timestamptz = Array {

1002− typoid = Oid 1185,

1468+ typoid = array_timestamptzOid,

1003 typcategory = 'A',

1469 typcategory = 'A',

1004 typdelim = ',',

1470 typdelim = ',',

1005 typname = "_timestamptz",

1471 typname = "_timestamptz",

1006 typelem = timestamptz

1472 typelem = timestamptz

1007 }

1473 }

1008

1474

1475+array_timestamptzOid :: Oid

1476+array_timestamptzOid = Oid 1185

1477+{-# INLINE array_timestamptzOid #-}

1478+

1009array_interval :: TypeInfo

1479array_interval :: TypeInfo

1010array_interval = Array {

1480array_interval = Array {

1011− typoid = Oid 1187,

1481+ typoid = array_intervalOid,

1012 typcategory = 'A',

1482 typcategory = 'A',

1013 typdelim = ',',

1483 typdelim = ',',

1014 typname = "_interval",

1484 typname = "_interval",

1015 typelem = interval

1485 typelem = interval

1016 }

1486 }

1017

1487

1488+array_intervalOid :: Oid

1489+array_intervalOid = Oid 1187

1490+{-# INLINE array_intervalOid #-}

1491+

1018array_numeric :: TypeInfo

1492array_numeric :: TypeInfo

1019array_numeric = Array {

1493array_numeric = Array {

1020− typoid = Oid 1231,

1494+ typoid = array_numericOid,

1021 typcategory = 'A',

1495 typcategory = 'A',

1022 typdelim = ',',

1496 typdelim = ',',

1023 typname = "_numeric",

1497 typname = "_numeric",

1024 typelem = numeric

1498 typelem = numeric

1025 }

1499 }

1026

1500

1501+array_numericOid :: Oid

1502+array_numericOid = Oid 1231

1503+{-# INLINE array_numericOid #-}

1504+

1027array_timetz :: TypeInfo

1505array_timetz :: TypeInfo

1028array_timetz = Array {

1506array_timetz = Array {

1029− typoid = Oid 1270,

1507+ typoid = array_timetzOid,

1030 typcategory = 'A',

1508 typcategory = 'A',

1031 typdelim = ',',

1509 typdelim = ',',

1032 typname = "_timetz",

1510 typname = "_timetz",

1033 typelem = timetz

1511 typelem = timetz

1034 }

1512 }

1035

1513

1514+array_timetzOid :: Oid

1515+array_timetzOid = Oid 1270

1516+{-# INLINE array_timetzOid #-}

1517+

1036array_bit :: TypeInfo

1518array_bit :: TypeInfo

1037array_bit = Array {

1519array_bit = Array {

1038− typoid = Oid 1561,

1520+ typoid = array_bitOid,

1039 typcategory = 'A',

1521 typcategory = 'A',

1040 typdelim = ',',

1522 typdelim = ',',

1041 typname = "_bit",

1523 typname = "_bit",

1042 typelem = bit

1524 typelem = bit

1043 }

1525 }

1044

1526

1527+array_bitOid :: Oid

1528+array_bitOid = Oid 1561

1529+{-# INLINE array_bitOid #-}

1530+

1045array_varbit :: TypeInfo

1531array_varbit :: TypeInfo

1046array_varbit = Array {

1532array_varbit = Array {

1047− typoid = Oid 1563,

1533+ typoid = array_varbitOid,

1048 typcategory = 'A',

1534 typcategory = 'A',

1049 typdelim = ',',

1535 typdelim = ',',

1050 typname = "_varbit",

1536 typname = "_varbit",

1051 typelem = varbit

1537 typelem = varbit

1052 }

1538 }

1053

1539

1540+array_varbitOid :: Oid

1541+array_varbitOid = Oid 1563

1542+{-# INLINE array_varbitOid #-}

1543+

1054array_refcursor :: TypeInfo

1544array_refcursor :: TypeInfo

1055array_refcursor = Array {

1545array_refcursor = Array {

1056− typoid = Oid 2201,

1546+ typoid = array_refcursorOid,

1057 typcategory = 'A',

1547 typcategory = 'A',

1058 typdelim = ',',

1548 typdelim = ',',

1059 typname = "_refcursor",

1549 typname = "_refcursor",

1060 typelem = refcursor

1550 typelem = refcursor

1061 }

1551 }

1062

1552

1553+array_refcursorOid :: Oid

1554+array_refcursorOid = Oid 2201

1555+{-# INLINE array_refcursorOid #-}

1556+

1063array_regprocedure :: TypeInfo

1557array_regprocedure :: TypeInfo

1064array_regprocedure = Array {

1558array_regprocedure = Array {

1065− typoid = Oid 2207,

1559+ typoid = array_regprocedureOid,

1066 typcategory = 'A',

1560 typcategory = 'A',

1067 typdelim = ',',

1561 typdelim = ',',

1068 typname = "_regprocedure",

1562 typname = "_regprocedure",

1069 typelem = regprocedure

1563 typelem = regprocedure

1070 }

1564 }

1071

1565

1566+array_regprocedureOid :: Oid

1567+array_regprocedureOid = Oid 2207

1568+{-# INLINE array_regprocedureOid #-}

1569+

1072array_regoper :: TypeInfo

1570array_regoper :: TypeInfo

1073array_regoper = Array {

1571array_regoper = Array {

1074− typoid = Oid 2208,

1572+ typoid = array_regoperOid,

1075 typcategory = 'A',

1573 typcategory = 'A',

1076 typdelim = ',',

1574 typdelim = ',',

1077 typname = "_regoper",

1575 typname = "_regoper",

1078 typelem = regoper

1576 typelem = regoper

1079 }

1577 }

1080

1578

1579+array_regoperOid :: Oid

1580+array_regoperOid = Oid 2208

1581+{-# INLINE array_regoperOid #-}

1582+

1081array_regoperator :: TypeInfo

1583array_regoperator :: TypeInfo

1082array_regoperator = Array {

1584array_regoperator = Array {

1083− typoid = Oid 2209,

1585+ typoid = array_regoperatorOid,

1084 typcategory = 'A',

1586 typcategory = 'A',

1085 typdelim = ',',

1587 typdelim = ',',

1086 typname = "_regoperator",

1588 typname = "_regoperator",

1087 typelem = regoperator

1589 typelem = regoperator

1088 }

1590 }

1089

1591

1592+array_regoperatorOid :: Oid

1593+array_regoperatorOid = Oid 2209

1594+{-# INLINE array_regoperatorOid #-}

1595+

1090array_regclass :: TypeInfo

1596array_regclass :: TypeInfo

1091array_regclass = Array {

1597array_regclass = Array {

1092− typoid = Oid 2210,

1598+ typoid = array_regclassOid,

1093 typcategory = 'A',

1599 typcategory = 'A',

1094 typdelim = ',',

1600 typdelim = ',',

1095 typname = "_regclass",

1601 typname = "_regclass",

1096 typelem = regclass

1602 typelem = regclass

1097 }

1603 }

1098

1604

1605+array_regclassOid :: Oid

1606+array_regclassOid = Oid 2210

1607+{-# INLINE array_regclassOid #-}

1608+

1099array_regtype :: TypeInfo

1609array_regtype :: TypeInfo

1100array_regtype = Array {

1610array_regtype = Array {

1101− typoid = Oid 2211,

1611+ typoid = array_regtypeOid,

1102 typcategory = 'A',

1612 typcategory = 'A',

1103 typdelim = ',',

1613 typdelim = ',',

1104 typname = "_regtype",

1614 typname = "_regtype",

1105 typelem = regtype

1615 typelem = regtype

1106 }

1616 }

1107

1617

1618+array_regtypeOid :: Oid

1619+array_regtypeOid = Oid 2211

1620+{-# INLINE array_regtypeOid #-}

1621+

1108array_uuid :: TypeInfo

1622array_uuid :: TypeInfo

1109array_uuid = Array {

1623array_uuid = Array {

1110− typoid = Oid 2951,

1624+ typoid = array_uuidOid,

1111 typcategory = 'A',

1625 typcategory = 'A',

1112 typdelim = ',',

1626 typdelim = ',',

1113 typname = "_uuid",

1627 typname = "_uuid",

1114 typelem = uuid

1628 typelem = uuid

1115 }

1629 }

1116

1630

1631+array_uuidOid :: Oid

1632+array_uuidOid = Oid 2951

1633+{-# INLINE array_uuidOid #-}

1634+

1117array_jsonb :: TypeInfo

1635array_jsonb :: TypeInfo

1118array_jsonb = Array {

1636array_jsonb = Array {

1119− typoid = Oid 3807,

1637+ typoid = array_jsonbOid,

1120 typcategory = 'A',

1638 typcategory = 'A',

1121 typdelim = ',',

1639 typdelim = ',',

1122 typname = "_jsonb",

1640 typname = "_jsonb",

1123 typelem = jsonb

1641 typelem = jsonb

1124 }

1642 }

1125

1643

1644+array_jsonbOid :: Oid

1645+array_jsonbOid = Oid 3807

1646+{-# INLINE array_jsonbOid #-}

1647+

1126int4range :: TypeInfo

1648int4range :: TypeInfo

1127int4range = Range {

1649int4range = Range {

1128− typoid = Oid 3904,

1650+ typoid = int4rangeOid,

1129 typcategory = 'R',

1651 typcategory = 'R',

1130 typdelim = ',',

1652 typdelim = ',',

1131 typname = "int4range",

1653 typname = "int4range",

1132 rngsubtype = int4

1654 rngsubtype = int4

1133 }

1655 }

1134

1656

1657+int4rangeOid :: Oid

1658+int4rangeOid = Oid 3904

1659+{-# INLINE int4rangeOid #-}

1660+

1135_int4range :: TypeInfo

1661_int4range :: TypeInfo

1136_int4range = Array {

1662_int4range = Array {

1137− typoid = Oid 3905,

1663+ typoid = _int4rangeOid,

1138 typcategory = 'A',

1664 typcategory = 'A',

1139 typdelim = ',',

1665 typdelim = ',',

1140 typname = "_int4range",

1666 typname = "_int4range",

1141 typelem = int4range

1667 typelem = int4range

1142 }

1668 }

1143

1669

1670+_int4rangeOid :: Oid

1671+_int4rangeOid = Oid 3905

1672+{-# INLINE _int4rangeOid #-}

1673+

1144numrange :: TypeInfo

1674numrange :: TypeInfo

1145numrange = Range {

1675numrange = Range {

1146− typoid = Oid 3906,

1676+ typoid = numrangeOid,

1147 typcategory = 'R',

1677 typcategory = 'R',

1148 typdelim = ',',

1678 typdelim = ',',

1149 typname = "numrange",

1679 typname = "numrange",

1150 rngsubtype = numeric

1680 rngsubtype = numeric

1151 }

1681 }

1152

1682

1683+numrangeOid :: Oid

1684+numrangeOid = Oid 3906

1685+{-# INLINE numrangeOid #-}

1686+

1153_numrange :: TypeInfo

1687_numrange :: TypeInfo

1154_numrange = Array {

1688_numrange = Array {

1155− typoid = Oid 3907,

1689+ typoid = _numrangeOid,

1156 typcategory = 'A',

1690 typcategory = 'A',

1157 typdelim = ',',

1691 typdelim = ',',

1158 typname = "_numrange",

1692 typname = "_numrange",

1159 typelem = numrange

1693 typelem = numrange

1160 }

1694 }

1161

1695

1696+_numrangeOid :: Oid

1697+_numrangeOid = Oid 3907

1698+{-# INLINE _numrangeOid #-}

1699+

1162tsrange :: TypeInfo

1700tsrange :: TypeInfo

1163tsrange = Range {

1701tsrange = Range {

1164− typoid = Oid 3908,

1702+ typoid = tsrangeOid,

1165 typcategory = 'R',

1703 typcategory = 'R',

1166 typdelim = ',',

1704 typdelim = ',',

1167 typname = "tsrange",

1705 typname = "tsrange",

1168 rngsubtype = timestamp

1706 rngsubtype = timestamp

1169 }

1707 }

1170

1708

1709+tsrangeOid :: Oid

1710+tsrangeOid = Oid 3908

1711+{-# INLINE tsrangeOid #-}

1712+

1171_tsrange :: TypeInfo

1713_tsrange :: TypeInfo

1172_tsrange = Array {

1714_tsrange = Array {

1173− typoid = Oid 3909,

1715+ typoid = _tsrangeOid,

1174 typcategory = 'A',

1716 typcategory = 'A',

1175 typdelim = ',',

1717 typdelim = ',',

1176 typname = "_tsrange",

1718 typname = "_tsrange",

1177 typelem = tsrange

1719 typelem = tsrange

1178 }

1720 }

1179

1721

1722+_tsrangeOid :: Oid

1723+_tsrangeOid = Oid 3909

1724+{-# INLINE _tsrangeOid #-}

1725+

1180tstzrange :: TypeInfo

1726tstzrange :: TypeInfo

1181tstzrange = Range {

1727tstzrange = Range {

1182− typoid = Oid 3910,

1728+ typoid = tstzrangeOid,

1183 typcategory = 'R',

1729 typcategory = 'R',

1184 typdelim = ',',

1730 typdelim = ',',

1185 typname = "tstzrange",

1731 typname = "tstzrange",

1186 rngsubtype = timestamptz

1732 rngsubtype = timestamptz

1187 }

1733 }

1188

1734

1735+tstzrangeOid :: Oid

1736+tstzrangeOid = Oid 3910

1737+{-# INLINE tstzrangeOid #-}

1738+

1189_tstzrange :: TypeInfo

1739_tstzrange :: TypeInfo

1190_tstzrange = Array {

1740_tstzrange = Array {

1191− typoid = Oid 3911,

1741+ typoid = _tstzrangeOid,

1192 typcategory = 'A',

1742 typcategory = 'A',

1193 typdelim = ',',

1743 typdelim = ',',

1194 typname = "_tstzrange",

1744 typname = "_tstzrange",

1195 typelem = tstzrange

1745 typelem = tstzrange

1196 }

1746 }

1197

1747

1748+_tstzrangeOid :: Oid

1749+_tstzrangeOid = Oid 3911

1750+{-# INLINE _tstzrangeOid #-}

1751+

1198daterange :: TypeInfo

1752daterange :: TypeInfo

1199daterange = Range {

1753daterange = Range {

1200− typoid = Oid 3912,

1754+ typoid = daterangeOid,

1201 typcategory = 'R',

1755 typcategory = 'R',

1202 typdelim = ',',

1756 typdelim = ',',

1203 typname = "daterange",

1757 typname = "daterange",

1204 rngsubtype = date

1758 rngsubtype = date

1205 }

1759 }

1206

1760

1761+daterangeOid :: Oid

1762+daterangeOid = Oid 3912

1763+{-# INLINE daterangeOid #-}

1764+

1207_daterange :: TypeInfo

1765_daterange :: TypeInfo

1208_daterange = Array {

1766_daterange = Array {

1209− typoid = Oid 3913,

1767+ typoid = _daterangeOid,

1210 typcategory = 'A',

1768 typcategory = 'A',

1211 typdelim = ',',

1769 typdelim = ',',

1212 typname = "_daterange",

1770 typname = "_daterange",

1213 typelem = daterange

1771 typelem = daterange

1214 }

1772 }

1215

1773

1774+_daterangeOid :: Oid

1775+_daterangeOid = Oid 3913

1776+{-# INLINE _daterangeOid #-}

1777+

1216int8range :: TypeInfo

1778int8range :: TypeInfo

1217int8range = Range {

1779int8range = Range {

1218− typoid = Oid 3926,

1780+ typoid = int8rangeOid,

1219 typcategory = 'R',

1781 typcategory = 'R',

1220 typdelim = ',',

1782 typdelim = ',',

1221 typname = "int8range",

1783 typname = "int8range",

1222 rngsubtype = int8

1784 rngsubtype = int8

1223 }

1785 }

1224

1786

1787+int8rangeOid :: Oid

1788+int8rangeOid = Oid 3926

1789+{-# INLINE int8rangeOid #-}

1790+

1225_int8range :: TypeInfo

1791_int8range :: TypeInfo

1226_int8range = Array {

1792_int8range = Array {

1227− typoid = Oid 3927,

1793+ typoid = _int8rangeOid,

1228 typcategory = 'A',

1794 typcategory = 'A',

1229 typdelim = ',',

1795 typdelim = ',',

1230 typname = "_int8range",

1796 typname = "_int8range",

1231 typelem = int8range

1797 typelem = int8range

1232 }

1798 }

1799+

1800+_int8rangeOid :: Oid

1801+_int8rangeOid = Oid 3927

1802+{-# INLINE _int8rangeOid #-}

src/Database/PostgreSQL/Simple/Types.hs+54−30

@@ -1,4 +1,4 @@

1−{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}

3------------------------------------------------------------------------------

4-- |

@@ -33,13 +33,16 @@ module Database.PostgreSQL.Simple.Types

33import Control.Arrow (first)

34import Data.ByteString (ByteString)

35import Data.Hashable (Hashable(hashWithSalt))

36+import Data.Foldable (toList)

36import Data.Monoid (Monoid(..))

37import Data.Monoid (Monoid(..))

38+import Data.Semigroup

37import Data.String (IsString(..))

39import Data.String (IsString(..))

38import Data.Typeable (Typeable)

40import Data.Typeable (Typeable)

39import Data.ByteString.Builder ( stringUtf8 )

41import Data.ByteString.Builder ( stringUtf8 )

40import qualified Data.ByteString as B

42import qualified Data.ByteString as B

41import Data.Text (Text)

43import Data.Text (Text)

42import qualified Data.Text as T

44import qualified Data.Text as T

45+import Data.Tuple.Only (Only(..))

43import Database.PostgreSQL.LibPQ (Oid(..))

46import Database.PostgreSQL.LibPQ (Oid(..))

44import Database.PostgreSQL.Simple.Compat (toByteString)

47import Database.PostgreSQL.Simple.Compat (toByteString)

@@ -47,10 +50,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

47data Null = Null

50data Null = Null

48 deriving (Read, Show, Typeable)

51 deriving (Read, Show, Typeable)

50−instance Eq Null where

51− _ == _ = False

52− _ /= _ = False

53−

54-- | A placeholder for the PostgreSQL @DEFAULT@ value.

53-- | A placeholder for the PostgreSQL @DEFAULT@ value.

55data Default = Default

54data Default = Default

56 deriving (Read, Show, Typeable)

55 deriving (Read, Show, Typeable)

@@ -87,28 +86,13 @@ instance Read Query where

87instance IsString Query where

86instance IsString Query where

88 fromString = Query . toByteString . stringUtf8

87 fromString = Query . toByteString . stringUtf8

89+instance Semigroup Query where

90+ Query a <> Query b = Query (B.append a b)

91+ {-# INLINE (<>) #-}

92+ sconcat xs = Query (B.concat $ map fromQuery $ toList xs)

93+

90instance Monoid Query where

94instance Monoid Query where

91 mempty = Query B.empty

95 mempty = Query B.empty

92− mappend (Query a) (Query b) = Query (B.append a b)

93− {-# INLINE mappend #-}

94− mconcat xs = Query (B.concat (map fromQuery xs))

95−

96−-- | A single-value \"collection\".

97−--

98−-- This is useful if you need to supply a single parameter to a SQL

99−-- query, or extract a single column from a SQL result.

100−--

101−-- Parameter example:

102−--

103−-- @query c \"select x from scores where x > ?\" ('Only' (42::Int))@

104−--

105−-- Result example:

106−--

107−-- @xs <- query_ c \"select id from users\"

108−--forM_ xs $ \\('Only' id) -> {- ... -}@

109−newtype Only a = Only {

110− fromOnly :: a

111− } deriving (Eq, Ord, Read, Show, Typeable, Functor)

112

113-- | Wrap a list of values for use in an @IN@ clause. Replaces a

97-- | Wrap a list of values for use in an @IN@ clause. Replaces a

114-- single \"@?@\" character with a parenthesized list of rendered

98-- single \"@?@\" character with a parenthesized list of rendered

@@ -117,6 +101,44 @@ newtype Only a = Only {

117-- Example:

101-- Example:

118--

102--

119-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))

103-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))

104+--

105+-- Note that @In []@ expands to @(null)@, which works as expected in

106+-- the query above, but evaluates to the logical null value on every

107+-- row instead of @TRUE@. This means that changing the query above

108+-- to @... id NOT in ?@ and supplying the empty list as the parameter

109+-- returns zero rows, instead of all of them as one would expect.

110+--

111+-- Since postgresql doesn't seem to provide a syntax for actually specifying

112+-- an empty list, which could solve this completely, there are two

113+-- workarounds particularly worth mentioning, namely:

114+--

115+-- 1. Use postgresql-simple's 'Values' type instead, which can handle the

116+-- empty case correctly. Note however that while specifying the

117+-- postgresql type @"int4"@ is mandatory in the empty case, specifying

118+-- the haskell type @Values (Only Int)@ would not normally be needed in

119+-- realistic use cases.

120+--

121+-- > query c "select * from whatever where id not in ?"

122+-- > (Only (Values ["int4"] [] :: Values (Only Int)))

123+--

124+--

125+-- 2. Use sql's @COALESCE@ operator to turn a logical @null@ into the correct

126+-- boolean. Note however that the correct boolean depends on the use

127+-- case:

128+--

129+-- > query c "select * from whatever where coalesce(id NOT in ?, TRUE)"

130+-- > (Only (In [] :: In [Int]))

131+--

132+-- > query c "select * from whatever where coalesce(id IN ?, FALSE)"

133+-- > (Only (In [] :: In [Int]))

134+--

135+-- Note that at as of PostgreSQL 9.4, the query planner cannot see inside

136+-- the @COALESCE@ operator, so if you have an index on @id@ then you

137+-- probably don't want to write the last example with @COALESCE@, which

138+-- would result in a table scan. There are further caveats if @id@ can

139+-- be null or you want null treated sensibly as a component of @IN@ or

140+-- @NOT IN@.

141+

120newtype In a = In a

142newtype In a = In a

121 deriving (Eq, Ord, Read, Show, Typeable, Functor)

143 deriving (Eq, Ord, Read, Show, Typeable, Functor)

122

144

@@ -179,8 +201,9 @@ infixr 3 :.

179newtype Savepoint = Savepoint Query

201newtype Savepoint = Savepoint Query

180 deriving (Eq, Ord, Show, Read, Typeable)

202 deriving (Eq, Ord, Show, Read, Typeable)

181

203

182−-- | Represents a @VALUES@ table literal, usable as an alternative

204+-- | Represents a @VALUES@ table literal, usable as an alternative to

205+-- 'Database.PostgreSQL.Simple.executeMany' and

183−-- to @executeMany@ and @returning@. The main advantage is that

206+-- 'Database.PostgreSQL.Simple.returning'. The main advantage is that

184-- you can parametrize more than just a single @VALUES@ expression.

207-- you can parametrize more than just a single @VALUES@ expression.

185-- For example, here's a query to insert a thing into one table

208-- For example, here's a query to insert a thing into one table

186-- and some attributes of that thing into another, returning the

209-- and some attributes of that thing into another, returning the

@@ -193,7 +216,7 @@ newtype Savepoint = Savepoint Query

193-- > ), new_attributes AS (

216-- > ), new_attributes AS (

194-- > INSERT INTO thing_attributes

217-- > INSERT INTO thing_attributes

195-- > SELECT new_thing.id, attrs.*

218-- > SELECT new_thing.id, attrs.*

196−-- > FROM new_thing JOIN ? attrs

219+-- > FROM new_thing JOIN ? attrs ON TRUE

197-- > ) SELECT * FROM new_thing

220-- > ) SELECT * FROM new_thing

198-- > |] ("foo", Values [ "int4", "text" ]

221-- > |] ("foo", Values [ "int4", "text" ]

199-- > [ ( 1 , "hello" )

222-- > [ ( 1 , "hello" )

@@ -219,7 +242,8 @@ newtype Savepoint = Savepoint Query

219-- is turned into a properly quoted identifier, the type name is case

242-- is turned into a properly quoted identifier, the type name is case

220-- sensitive and must be as it appears in the @pg_type@ table. Thus,

243-- sensitive and must be as it appears in the @pg_type@ table. Thus,

221-- you must write @timestamptz@ instead of @timestamp with time zone@,

244-- you must write @timestamptz@ instead of @timestamp with time zone@,

222−-- @int4@ instead of @integer@, @_int8@ instead of @bigint[]@, etcetera.

245+-- @int4@ instead of @integer@ or @serial@, @_int8@ instead of @bigint[]@,

246+-- etcetera.

223--

247--

224-- You may omit the type names, however, if you do so the list

248-- You may omit the type names, however, if you do so the list

225-- of values must be non-empty, and postgresql must be able to infer

249-- of values must be non-empty, and postgresql must be able to infer

@@ -228,7 +252,7 @@ newtype Savepoint = Savepoint Query

228-- without issuing the query. In the second case, the postgres server

252-- without issuing the query. In the second case, the postgres server

229-- will return an error which will be turned into a @SqlError@ exception.

253-- will return an error which will be turned into a @SqlError@ exception.

230--

254--

231−-- See <http://www.postgresql.org/docs/9.3/static/sql-values.html> for

255+-- See <https://www.postgresql.org/docs/9.5/static/sql-values.html> for

232-- more information.

256-- more information.

233data Values a = Values [QualifiedIdentifier] [a]

257data Values a = Values [QualifiedIdentifier] [a]

234 deriving (Eq, Ord, Show, Read, Typeable)

258 deriving (Eq, Ord, Show, Read, Typeable)

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/Common.hs+2−2

@@ -1,6 +1,6 @@

1module Common (

2 module Database.PostgreSQL.Simple,

3− module Test.HUnit,

3+ module Test.Tasty.HUnit,

4 TestEnv(..),

5 md5,

6) where

@@ -8,7 +8,7 @@ module Common (

8import Data.ByteString (ByteString)

9import Data.Text (Text)

10import Database.PostgreSQL.Simple

11−import Test.HUnit

11+import Test.Tasty.HUnit

13import qualified Crypto.Hash.MD5 as MD5

14import qualified Data.ByteString.Base16 as Base16

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+343−59

@@ -1,53 +1,95 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DoAndIfThenElse #-}

4{-# LANGUAGE DoAndIfThenElse #-}

3{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6+#if __GLASGOW_HASKELL__ >= 806

7+{-# LANGUAGE DerivingStrategies #-}

8+{-# LANGUAGE DerivingVia #-}

9+{-# LANGUAGE DeriveAnyClass #-}

10+#endif

11+module Main (main) where

12+

4import Common

13import Common

14+import Database.PostgreSQL.Simple.Copy

15+import Database.PostgreSQL.Simple.ToField (ToField)

5import Database.PostgreSQL.Simple.FromField (FromField)

16import Database.PostgreSQL.Simple.FromField (FromField)

6−import Database.PostgreSQL.Simple.Types(Query(..),Values(..))

7import Database.PostgreSQL.Simple.HStore

17import Database.PostgreSQL.Simple.HStore

8−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(..))

9import qualified Database.PostgreSQL.Simple.Transaction as ST

21import qualified Database.PostgreSQL.Simple.Transaction as ST

22+

10import Control.Applicative

23import Control.Applicative

11import Control.Exception as E

24import Control.Exception as E

12import Control.Monad

25import Control.Monad

13−import Data.ByteString (ByteString)

26+import Data.Char

27+import Data.Foldable (toList)

28+import Data.List (concat, sort)

14import Data.IORef

29import Data.IORef

30+import Data.Monoid ((<>))

31+import Data.String (fromString)

15import Data.Typeable

32import Data.Typeable

33+import GHC.Generics (Generic)

34+

35+import Data.Aeson

36+import Data.ByteString (ByteString)

16import qualified Data.ByteString as B

37import qualified Data.ByteString as B

38+import qualified Data.ByteString.Char8 as BS8

39+import qualified Data.ByteString.Lazy.Char8 as BL

40+import Data.CaseInsensitive (CI)

41+import qualified Data.CaseInsensitive as CI

17import Data.Map (Map)

42import Data.Map (Map)

18−import Data.List (sort)

19import qualified Data.Map as Map

43import qualified Data.Map as Map

20import Data.Text(Text)

44import Data.Text(Text)

21import qualified Data.Text.Encoding as T

45import qualified Data.Text.Encoding as T

22−import System.Exit (exitFailure)

23−import System.IO

24import qualified Data.Vector as V

46import qualified Data.Vector as V

25−import Data.Aeson

47+import System.FilePath

48+import System.Timeout(timeout)

49+import Data.Time.Compat (getCurrentTime, diffUTCTime)

50+import System.Environment (getEnvironment)

52+import Test.Tasty

53+import Test.Tasty.Golden

27import Notify

54import Notify

28import Serializable

55import Serializable

29import Time

56import Time

30−

57+import Interval

58+import Exception (testExceptions)

59+

31−tests :: [TestEnv -> Test]

60+tests :: TestEnv -> TestTree

32−tests =

61+tests env = testGroup "tests"

62+ $ map ($ env)

33− [ TestLabel "Bytea" . testBytea

63+ [ testBytea

34− , TestLabel "ExecuteMany" . testExecuteMany

64+ , testCase "ExecuteMany" . testExecuteMany

35− , TestLabel "Fold" . testFold

65+ , testCase "Fold" . testFold

36− , TestLabel "Notify" . testNotify

66+ , testCase "Notify" . testNotify

37− , TestLabel "Serializable" . testSerializable

67+ , testCase "Serializable" . testSerializable

38− , TestLabel "Time" . testTime

68+ , testCase "Time" . testTime

69+ , testCase "Interval" . testInterval

39− , TestLabel "Array" . testArray

70+ , testCase "Array" . testArray

71+ , testCase "Array of nullables" . testNullableArray

40− , TestLabel "HStore" . testHStore

72+ , testCase "HStore" . testHStore

73+ , testCase "citext" . testCIText

41− , TestLabel "JSON" . testJSON

74+ , testCase "JSON" . testJSON

75+ , testCase "Aeson newtype" . testAeson

76+ , testCase "DerivingVia" . testDerivingVia

77+ , testCase "Question mark escape" . testQM

42− , TestLabel "Savepoint" . testSavepoint

78+ , testCase "Savepoint" . testSavepoint

43− , TestLabel "Unicode" . testUnicode

79+ , testCase "Unicode" . testUnicode

44− , TestLabel "Values" . testValues

80+ , testCase "Values" . testValues

45− , TestLabel "Copy" . testCopy

81+ , testCase "Copy" . testCopy

82+ , testCopyFailures

46− , TestLabel "Double" . testDouble

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

47 ]

89 ]

49−testBytea :: TestEnv -> Test

91+testBytea :: TestEnv -> TestTree

50−testBytea TestEnv{..} = TestList

92+testBytea TestEnv{..} = testGroup "Bytea"

51 [ testStr "empty" []

93 [ testStr "empty" []

52 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

94 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

53 , testStr "ascending" [0..255]

95 , testStr "ascending" [0..255]

@@ -56,7 +98,7 @@ testBytea TestEnv{..} = TestList

56 , testStr "descending, doubled up" $ doubleUp [255,254..0]

98 , testStr "descending, doubled up" $ doubleUp [255,254..0]

57 ]

99 ]

58 where

100 where

59− testStr label bytes = TestLabel label $ TestCase $ do

101+ testStr label bytes = testCase label $ do

60 let bs = B.pack bytes

102 let bs = B.pack bytes

103

62 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]

104 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]

@@ -67,8 +109,8 @@ testBytea TestEnv{..} = TestList

109

68 doubleUp = concatMap (\x -> [x, x])

110 doubleUp = concatMap (\x -> [x, x])

111

70−testExecuteMany :: TestEnv -> Test

112+testExecuteMany :: TestEnv -> Assertion

71−testExecuteMany TestEnv{..} = TestCase $ do

113+testExecuteMany TestEnv{..} = do

72 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"

114 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"

115

74 let rows :: [(Int, String, Binary ByteString)]

116 let rows :: [(Int, String, Binary ByteString)]

@@ -85,8 +127,8 @@ testExecuteMany TestEnv{..} = TestCase $ do

127

86 return ()

128 return ()

129

88−testFold :: TestEnv -> Test

130+testFold :: TestEnv -> Assertion

89−testFold TestEnv{..} = TestCase $ do

131+testFold TestEnv{..} = do

90 xs <- fold_ conn "SELECT generate_series(1,10000)"

132 xs <- fold_ conn "SELECT generate_series(1,10000)"

91 [] $ \xs (Only x) -> return (x:xs)

133 [] $ \xs (Only x) -> return (x:xs)

92 reverse xs @?= ([1..10000] :: [Int])

134 reverse xs @?= ([1..10000] :: [Int])

@@ -97,7 +139,7 @@ testFold TestEnv{..} = TestCase $ do

97 xs <- readIORef ref

139 xs <- readIORef ref

98 writeIORef ref $! (a,b):xs

140 writeIORef ref $! (a,b):xs

99 xs <- readIORef ref

141 xs <- readIORef ref

100− reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]

142+ reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]

101

143

102 -- Make sure fold propagates our exception.

144 -- Make sure fold propagates our exception.

103 ref <- newIORef []

145 ref <- newIORef []

@@ -155,8 +197,8 @@ queryFailure conn q resultType = do

155 ++ show (typeOf resultType)

197 ++ show (typeOf resultType)

156 ++ " -> " ++ show val)

198 ++ " -> " ++ show val)

157

199

158−testArray :: TestEnv -> Test

200+testArray :: TestEnv -> Assertion

159−testArray TestEnv{..} = TestCase $ do

201+testArray TestEnv{..} = do

160 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"

202 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"

161 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]

203 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]

162 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"

204 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"

@@ -165,8 +207,16 @@ testArray TestEnv{..} = TestCase $ do

165 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)

207 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)

166 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)

208 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)

167

209

168−testHStore :: TestEnv -> Test

210+testNullableArray :: TestEnv -> Assertion

169−testHStore TestEnv{..} = TestCase $ do

211+testNullableArray TestEnv{..} = do

212+ xs <- query_ conn "SELECT '{sometext, \"NULL\"}'::_text"

213+ xs @?= [Only (V.fromList ["sometext", "NULL" :: Text])]

214+ xs <- query_ conn "SELECT '{sometext, NULL}'::_text"

215+ xs @?= [Only (V.fromList [Just "sometext", Nothing :: Maybe Text])]

216+ queryFailure conn "SELECT '{sometext, NULL}'::_text" (undefined :: V.Vector Text)

217+

218+testHStore :: TestEnv -> Assertion

219+testHStore TestEnv{..} = do

170 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"

220 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"

171 roundTrip []

221 roundTrip []

172 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]

222 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]

@@ -178,8 +228,21 @@ testHStore TestEnv{..} = TestCase $ do

178 m' <- query conn "SELECT ?::hstore" m

228 m' <- query conn "SELECT ?::hstore" m

179 [m] @?= m'

229 [m] @?= m'

180

230

231+testCIText :: TestEnv -> Assertion

232+testCIText TestEnv{..} = do

233+ execute_ conn "CREATE EXTENSION IF NOT EXISTS citext"

234+ roundTrip (CI.mk "")

235+ roundTrip (CI.mk "UPPERCASE")

236+ roundTrip (CI.mk "lowercase")

237+ where

238+ roundTrip :: (CI Text) -> Assertion

239+ roundTrip cit = do

240+ let toPostgres = Only cit

241+ fromPostgres <- query conn "SELECT ?::citext" toPostgres

242+ [toPostgres] @?= fromPostgres

243+

181−testJSON :: TestEnv -> Test

244+testJSON :: TestEnv -> Assertion

182−testJSON TestEnv{..} = TestCase $ do

245+testJSON TestEnv{..} = do

183 roundTrip (Map.fromList [] :: Map Text Text)

246 roundTrip (Map.fromList [] :: Map Text Text)

184 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

247 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

185 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

248 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

@@ -193,8 +256,92 @@ testJSON TestEnv{..} = TestCase $ do

193 js' <- query conn "SELECT ?::json" js

256 js' <- query conn "SELECT ?::json" js

194 [js] @?= js'

257 [js] @?= js'

195

258

196−testSavepoint :: TestEnv -> Test

259+testAeson :: TestEnv -> Assertion

197−testSavepoint TestEnv{..} = TestCase $ do

260+testAeson TestEnv{..} = do

261+ roundTrip (Map.fromList [] :: Map Text Text)

262+ roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

263+ roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

264+ roundTrip (V.fromList [1,2,3,4,5::Int])

265+ roundTrip ("foo" :: Text)

266+ roundTrip (42 :: Int)

267+ where

268+ roundTrip :: (Eq a, Show a, Typeable a, ToJSON a, FromJSON a)=> a -> Assertion

269+ roundTrip x = do

270+ y <- query conn "SELECT ?::json" (Only (Aeson x))

271+ [Only (Aeson x)] @?= y

272+

273+testDerivingVia :: TestEnv -> Assertion

274+testDerivingVia TestEnv{..} = do

275+#if __GLASGOW_HASKELL__ <806

276+ return ()

277+#else

278+ roundTrip $ DerivingVia1 42 "Meaning of Life"

279+ where

280+ roundTrip :: (Eq a, Show a, Typeable a, ToField a, FromField a)=> a -> Assertion

281+ roundTrip x = do

282+ y <- query conn "SELECT ?::json" (Only x)

283+ [Only x] @?= y

284+

285+data DerivingVia1 = DerivingVia1 Int String

286+ deriving stock (Eq, Show, Generic)

287+ deriving anyclass (FromJSON, ToJSON)

288+ deriving (ToField, FromField) via Aeson DerivingVia1

289+

290+#endif

291+

292+

293+testQM :: TestEnv -> Assertion

294+testQM TestEnv{..} = do

295+ -- Just test on a single string

296+ let testQuery' b = "testing for ?" <> b <> " and making sure "

297+ testQueryDoubleQM = testQuery' "?"

298+ testQueryRest = "? is substituted"

299+ testQuery = fromString $ testQueryDoubleQM <> testQueryRest

300+ -- expect the entire first part with double QMs replaced with literal '?'

301+ expected = (fromString $ testQuery' "", fromString testQueryRest)

302+ tried = breakOnSingleQuestionMark testQuery

303+ errMsg = concat

304+ [ "Failed to break on single question mark exclusively:\n"

305+ , "expected: ", show expected

306+ , "result: ", show tried

307+ ]

308+ assertBool errMsg $ tried == expected

309+

310+ -- Let's also test the question mark operators in action

311+ -- ? -> Does the string exist as a top-level key within the JSON value?

312+ positiveQuery "SELECT ?::jsonb ?? ?" (testObj, "foo" :: Text)

313+ negativeQuery "SELECT ?::jsonb ?? ?" (testObj, "baz" :: Text)

314+ negativeQuery "SELECT ?::jsonb ?? ?" (toJSON numArray, "1" :: Text)

315+ -- ?| -> Do any of these array strings exist as top-level keys?

316+ positiveQuery "SELECT ?::jsonb ??| ?" (testObj, PGArray ["nope","bar","6" :: Text])

317+ negativeQuery "SELECT ?::jsonb ??| ?" (testObj, PGArray ["nope","6" :: Text])

318+ negativeQuery "SELECT ?::jsonb ??| ?" (toJSON numArray, PGArray ["1","2","6" :: Text])

319+ -- ?& -> Do all of these array strings exist as top-level keys?

320+ positiveQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar","quux" :: Text])

321+ positiveQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar" :: Text])

322+ negativeQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar","baz" :: Text])

323+ negativeQuery "SELECT ?::jsonb ??& ?" (toJSON numArray, PGArray ["1","2","3","4","5" :: Text])

324+ -- Format error for 2 question marks, not 4

325+ True <- expectError (isFormatError 2) $

326+ (query conn "SELECT ?::jsonb ?? ?" $ Only testObj :: IO [Only Bool])

327+ return ()

328+ where positiveQuery :: ToRow a => Query -> a -> Assertion

329+ positiveQuery = boolQuery True

330+ negativeQuery :: ToRow a => Query -> a -> Assertion

331+ negativeQuery = boolQuery False

332+ numArray :: [Int]

333+ numArray = [1,2,3,4,5]

334+ boolQuery :: ToRow a => Bool -> Query -> a -> Assertion

335+ boolQuery b t x = do

336+ a <- query conn t x

337+ [Only b] @?= a

338+ testObj = toJSON (Map.fromList [("foo",toJSON (1 :: Int))

339+ ,("bar",String "baz")

340+ ,("quux",toJSON [1 :: Int,2,3,4,5])] :: Map Text Value

341+ )

342+

343+testSavepoint :: TestEnv -> Assertion

344+testSavepoint TestEnv{..} = do

198 True <- expectError ST.isNoActiveTransactionError $

345 True <- expectError ST.isNoActiveTransactionError $

199 withSavepoint conn $ return ()

346 withSavepoint conn $ return ()

200

347

@@ -254,8 +401,8 @@ testSavepoint TestEnv{..} = TestCase $ do

254

401

255 return ()

402 return ()

256

403

257−testUnicode :: TestEnv -> Test

404+testUnicode :: TestEnv -> Assertion

258−testUnicode TestEnv{..} = TestCase $ do

405+testUnicode TestEnv{..} = do

259 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure

406 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure

260 -- the table gets created correctly.

407 -- the table gets created correctly.

261 let messages = map Only ["привет","мир"] :: [Only Text]

408 let messages = map Only ["привет","мир"] :: [Only Text]

@@ -264,8 +411,8 @@ testUnicode TestEnv{..} = TestCase $ do

264 messages' <- query_ conn "SELECT сообщение FROM ру́сский"

411 messages' <- query_ conn "SELECT сообщение FROM ру́сский"

265 sort messages @?= sort messages'

412 sort messages @?= sort messages'

266

413

267−testValues :: TestEnv -> Test

414+testValues :: TestEnv -> Assertion

268−testValues TestEnv{..} = TestCase $ do

415+testValues TestEnv{..} = do

269 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"

416 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"

270 test (Values ["int4","text"] [])

417 test (Values ["int4","text"] [])

271 test (Values ["int4","text"] [(1,"hello")])

418 test (Values ["int4","text"] [(1,"hello")])

@@ -282,8 +429,8 @@ testValues TestEnv{..} = TestCase $ do

282 sort vals @?= sort vals'

429 sort vals @?= sort vals'

283

430

284

431

285−testCopy :: TestEnv -> Test

432+testCopy :: TestEnv -> Assertion

286−testCopy TestEnv{..} = TestCase $ do

433+testCopy TestEnv{..} = do

287 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"

434 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"

288 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"

435 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"

289 mapM_ (putCopyData conn) copyRows

436 mapM_ (putCopyData conn) copyRows

@@ -300,6 +447,14 @@ testCopy TestEnv{..} = TestCase $ do

300 -- so that we can issue more queries:

447 -- so that we can issue more queries:

301 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

302 x @?= 4

449 x @?= 4

450+ -- foldCopyData

451+ copy_ conn "COPY copy_test TO STDOUT (FORMAT CSV)"

452+ (acc, count) <- foldCopyData conn

453+ (\acc row -> return (row:acc))

454+ (\acc count -> return (acc, count))

455+ []

456+ sort acc @?= sort copyRows

457+ count @?= 2

303 where

458 where

304 copyRows = ["1,foo\n"

459 copyRows = ["1,foo\n"

305 ,"2,bar\n"]

460 ,"2,bar\n"]

@@ -310,8 +465,70 @@ testCopy TestEnv{..} = TestCase $ do

310 CopyOutDone _ -> return rows

465 CopyOutDone _ -> return rows

311 CopyOutRow row -> loop (row:rows)

466 CopyOutRow row -> loop (row:rows)

312

467

313−testDouble :: TestEnv -> Test

468+testCopyFailures :: TestEnv -> TestTree

314−testDouble TestEnv{..} = TestCase $ do

469+testCopyFailures env = testGroup "Copy failures"

470+ $ map ($ env)

471+ [ testCopyUniqueConstraintError

472+ , testCopyMalformedError

473+ ]

474+

475+goldenTest :: TestName -> IO BL.ByteString -> TestTree

476+goldenTest testName =

477+ goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")

478+ where

479+ resultsDir = "test" </> "results"

480+ fileName = map normalize testName

481+ normalize c | not (isAlpha c) = '-'

482+ | otherwise = c

483+ diff ref new = ["diff", "-u", ref, new]

484+

485+-- | Test that we provide a sensible error message on failure

486+testCopyUniqueConstraintError :: TestEnv -> TestTree

487+testCopyUniqueConstraintError TestEnv{..} =

488+ goldenTest "unique constraint violation"

489+ $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do

490+ execute_ conn "CREATE TEMPORARY TABLE copy_unique_constraint_error_test (x int PRIMARY KEY, y text)"

491+ copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"

492+ mapM_ (putCopyData conn) copyRows

493+ _n <- putCopyEnd conn

494+ return BL.empty

495+ where

496+ copyRows = ["1,foo\n"

497+ ,"2,bar\n"

498+ ,"1,baz\n"]

499+

500+testCopyMalformedError :: TestEnv -> TestTree

501+testCopyMalformedError TestEnv{..} =

502+ goldenTest "malformed input"

503+ $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do

504+ execute_ conn "CREATE TEMPORARY TABLE copy_malformed_input_error_test (x int PRIMARY KEY, y text)"

505+ copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"

506+ mapM_ (putCopyData conn) copyRows

507+ _n <- putCopyEnd conn

508+ return BL.empty

509+ where

510+ copyRows = ["1,foo\n"

511+ ,"2,bar\n"

512+ ,"z,baz\n"]

513+

514+testTimeout :: TestEnv -> Assertion

515+testTimeout TestEnv{..} =

516+ withConn $ \c -> do

517+ start_t <- getCurrentTime

518+ res <- timeout 200000 $ do

519+ withTransaction c $ do

520+ query_ c "SELECT pg_sleep(1)" :: IO [Only ()]

521+ end_t <- getCurrentTime

522+ assertBool "Timeout did not occur" (res == Nothing)

523+#if !defined(mingw32_HOST_OS)

524+-- At the moment, you cannot timely abandon queries with async exceptions on

525+-- Windows.

526+ let d = end_t `diffUTCTime` start_t

527+ assertBool "Timeout didn't work in a timely fashion" (0.1 < d && d < 0.6)

528+#endif

529+

530+testDouble :: TestEnv -> Assertion

531+testDouble TestEnv{..} = do

315 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"

532 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"

316 assertBool "expected NaN" (isNaN x)

533 assertBool "expected NaN" (isNaN x)

317 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"

534 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"

@@ -320,6 +537,45 @@ testDouble TestEnv{..} = TestCase $ do

320 x @?= (-1 / 0)

537 x @?= (-1 / 0)

321

538

322

539

540+testGeneric1 :: TestEnv -> Assertion

541+testGeneric1 TestEnv{..} = do

542+ roundTrip conn (Gen1 123)

543+ where

544+ roundTrip conn x0 = do

545+ r <- query conn "SELECT ?::int" (x0 :: Gen1)

546+ r @?= [x0]

547+

548+testGeneric2 :: TestEnv -> Assertion

549+testGeneric2 TestEnv{..} = do

550+ roundTrip conn (Gen2 123 "asdf")

551+ where

552+ roundTrip conn x0 = do

553+ r <- query conn "SELECT ?::int, ?::text" x0

554+ r @?= [x0]

555+

556+testGeneric3 :: TestEnv -> Assertion

557+testGeneric3 TestEnv{..} = do

558+ roundTrip conn (Gen3 123 "asdf" True)

559+ where

560+ roundTrip conn x0 = do

561+ r <- query conn "SELECT ?::int, ?::text, ?::bool" x0

562+ r @?= [x0]

563+

564+data Gen1 = Gen1 Int

565+ deriving (Show,Eq,Generic)

566+instance FromRow Gen1

567+instance ToRow Gen1

568+

569+data Gen2 = Gen2 Int Text

570+ deriving (Show,Eq,Generic)

571+instance FromRow Gen2

572+instance ToRow Gen2

573+

574+data Gen3 = Gen3 Int Text Bool

575+ deriving (Show,Eq,Generic)

576+instance FromRow Gen3

577+instance ToRow Gen3

578+

323data TestException

579data TestException

324 = TestException

580 = TestException

325 deriving (Eq, Show, Typeable)

581 deriving (Eq, Show, Typeable)

@@ -337,28 +593,56 @@ isUniqueViolation SqlError{..} = sqlState == "23505"

337isSyntaxError :: SqlError -> Bool

593isSyntaxError :: SqlError -> Bool

338isSyntaxError SqlError{..} = sqlState == "42601"

594isSyntaxError SqlError{..} = sqlState == "42601"

339

595

596+isFormatError :: Int -> FormatError -> Bool

597+isFormatError i FormatError{..}

598+ | null fmtMessage = False

599+ | otherwise = fmtMessage == concat [ show i

600+ , " single '?' characters, but "

601+ , show (length fmtParams)

602+ , " parameters"

603+ ]

340------------------------------------------------------------------------

604------------------------------------------------------------------------

341

605

342-- | Action for connecting to the database that will be used for testing.

606-- | Action for connecting to the database that will be used for testing.

343--

607--

344-- Note that some tests, such as Notify, use multiple connections, and assume

608-- Note that some tests, such as Notify, use multiple connections, and assume

345-- that 'testConnect' connects to the same database every time it is called.

609-- that 'testConnect' connects to the same database every time it is called.

346−testConnect :: IO Connection

610+withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

347−testConnect = connectPostgreSQL ""

611+withTestEnv connstr cb =

612+ withConn $ \conn -> do

613+ -- currently required for interval to work.

614+ -- we also test that this doesn't interfere with anything else

615+ execute_ conn "SET intervalstyle TO 'iso_8601'"

348

616

349−withTestEnv :: (TestEnv -> IO a) -> IO a

350−withTestEnv cb =

351− withConn $ \conn ->

352 cb TestEnv

617 cb TestEnv

353 { conn = conn

618 { conn = conn

354 , withConn = withConn

619 , withConn = withConn

355 }

620 }

356 where

621 where

357− withConn = bracket testConnect close

622+ withConn = bracket (connectPostgreSQL connstr) close

358

623

359main :: IO ()

624main :: IO ()

360−main = do

625+main = withConnstring $ \connstring -> do

361− mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]

362− Counts{cases, tried, errors, failures} <-

363− withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests

626+ withTestEnv connstring (defaultMain . tests)

364− when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure

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/Notify.hs+1−2

@@ -14,9 +14,8 @@ import qualified Data.ByteString as B

14-- TODO: Test with payload, but only for PostgreSQL >= 9.0

15-- (when that feature was introduced).

17−testNotify :: TestEnv -> Test

17+testNotify :: TestEnv -> Assertion

18testNotify TestEnv{..} =

19− TestCase $

20 withConn $ \conn2 -> do

19 withConn $ \conn2 -> do

21 execute_ conn "LISTEN foo"

20 execute_ conn "LISTEN foo"

22 execute_ conn "LISTEN bar"

21 execute_ conn "LISTEN bar"

test/Serializable.hs+1−2

@@ -23,9 +23,8 @@ putCounter conn n = do

23 1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)

24 return ()

26−testSerializable :: TestEnv -> Test

26+testSerializable :: TestEnv -> Assertion

27testSerializable TestEnv{..} =

28− TestCase $

29 withConn $ \conn2 -> do

28 withConn $ \conn2 -> do

30 initCounter conn

29 initCounter conn

test/Time.hs+18−10

@@ -36,26 +36,26 @@ module Time (testTime) where

37import Common

38import Control.Monad(forM_, replicateM_)

39−import Data.Time

39+import Data.Time.Compat

40import Data.ByteString(ByteString)

41import Database.PostgreSQL.Simple.SqlQQ

43numTests :: Int

44numTests = 200

46−testTime :: TestEnv -> Test

46+testTime :: TestEnv -> Assertion

47−testTime env@TestEnv{..} = TestCase $ do

47+testTime env@TestEnv{..} = do

48 initializeTable env

49 execute_ conn "SET timezone TO 'UTC'"

50− checkRoundTrips env

50+ checkRoundTrips env "1860-01-01 00:00:00+00"

51 execute_ conn "SET timezone TO 'America/Chicago'" -- -5:00

52− checkRoundTrips env

52+ checkRoundTrips env "1883-11-18 12:00:00-06"

53 execute_ conn "SET timezone TO 'Asia/Tokyo'" -- +9:00

54− checkRoundTrips env

54+ checkRoundTrips env "1888-01-01 00:00:00+09"

55 execute_ conn "SET timezone TO 'Asia/Kathmandu'" -- +5:45

56− checkRoundTrips env

56+ checkRoundTrips env "1919-12-31 23:48:44+05:30"

57 execute_ conn "SET timezone TO 'America/St_Johns'" -- -3:30

58− checkRoundTrips env

58+ checkRoundTrips env "1935-03-30 00:00:52-03:30"

60initializeTable :: TestEnv -> IO ()

61initializeTable TestEnv{..} = withTransaction conn $ do

@@ -102,10 +102,18 @@ initializeTable TestEnv{..} = withTransaction conn $ do

102 pop "100 milliseconds" 6.3113904e10

103 pop "1 second" 6.3113904e9

104

105−checkRoundTrips :: TestEnv -> IO ()

105+checkRoundTrips :: TestEnv -> ByteString -> IO ()

106−checkRoundTrips TestEnv{..} = do

106+checkRoundTrips TestEnv{..} limit = do

107 yxs :: [(UTCTime, Int)] <- query_ conn [sql| SELECT y, x FROM testtime |]

108 forM_ yxs $ \yx -> do

109 res <- query conn [sql| SELECT y=? FROM testtime WHERE x=? |] yx

110 assertBool "UTCTime did not round-trip from SQL to Haskell and back" $

111 res == [Only True]

112+

113+ yxs :: [(ZonedTime, Int)] <- query conn [sql|

114+ SELECT y, x FROM testtime WHERE y > ?

115+ |] (Only limit)

116+ forM_ yxs $ \yx -> do

117+ res <- query conn [sql| SELECT y=? FROM testtime WHERE x=? |] yx

118+ assertBool "ZonedTime did not round-trip from SQL to Haskell and back" $

119+ res == [Only True]

test/results/malformed-input.expectednew file+4

@@ -0,0 +1,4 @@

1+user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2+Connection error: ERROR: invalid input syntax for type integer: "z"

3+CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

4+)

test/results/unique-constraint-violation.expectednew file+5

@@ -0,0 +1,5 @@

1+user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2+Connection error: ERROR: duplicate key value violates unique constraint "copy_unique_constraint_error_test_pkey"

3+DETAIL: Key (x)=(1) already exists.

4+CONTEXT: COPY copy_unique_constraint_error_test, line 3

5+)

tools/GenTypeInfo.hs+39−25

@@ -21,6 +21,9 @@

21-- know about. It then constructs a TypeInfo record and stores it in

22-- a per-connection cache for later use.

23--

24+-- @

25+-- runghc -itools tools/GenTypeInfo.hs

26+-- @

24------------------------------------------------------------------------------

27------------------------------------------------------------------------------

26{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

29{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

@@ -38,12 +41,10 @@ import Database.PostgreSQL.Simple.FromRow

38import Database.PostgreSQL.Simple.Ok

41import Database.PostgreSQL.Simple.Ok

39import Database.PostgreSQL.Simple.Types(Oid(..))

42import Database.PostgreSQL.Simple.Types(Oid(..))

40import Database.PostgreSQL.Simple.SqlQQ

43import Database.PostgreSQL.Simple.SqlQQ

41−import qualified Data.ByteString.Char8 as B

44+import qualified Data.ByteString.Char8 as B8

42import Data.ByteString(ByteString)

45import Data.ByteString(ByteString)

43import qualified Data.ByteString.Lazy as L

46import qualified Data.ByteString.Lazy as L

44−import qualified Blaze.ByteString.Builder as Blaze

47+import qualified Data.ByteString.Builder as Blaze

45−import qualified Blaze.ByteString.Builder.ByteString as Blaze

46−import qualified Blaze.ByteString.Builder.Char8 as Blaze

47import Data.String

48import Data.String

48import Data.List ( sort, intersperse )

49import Data.List ( sort, intersperse )

49import qualified Data.Map as Map

50import qualified Data.Map as Map

@@ -69,11 +70,11 @@ data TypeInfo = TypeInfo

69instance FromRow TypeInfo where

70instance FromRow TypeInfo where

70 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

71 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

72−type NameMap = Map.Map B.ByteString TypeInfo

73+type NameMap = Map.Map B8.ByteString TypeInfo

74type OidMap = Map.Map Oid TypeInfo

75type OidMap = Map.Map Oid TypeInfo

76−type TypeName = (B.ByteString, B.ByteString)

77+type TypeName = (B8.ByteString, B8.ByteString)

78type TypeNames = [TypeName]

79type TypeNames = [TypeName]

@@ -197,9 +198,6 @@ int8range

197_int8range

198_int8range

198|]

199|]

199

200

200−instance IsString Blaze.Builder where

201− fromString = Blaze.fromByteString . fromString

202−

203connectionString = "dbname=postgres"

201connectionString = "dbname=postgres"

204

202

205withPostgreSQL = bracket (connectPostgreSQL connectionString) close

203withPostgreSQL = bracket (connectPostgreSQL connectionString) close

@@ -237,7 +235,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do

237

235

238main = do

236main = do

239 (oidmap, namemap) <- getTypeInfos typeNames

237 (oidmap, namemap) <- getTypeInfos typeNames

240− L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

238+ L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

241 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

239 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

242

240

243

241

@@ -246,7 +244,7 @@ showOid (Oid n) = show n

246renderOid :: NameMap -> TypeName -> Blaze.Builder

244renderOid :: NameMap -> TypeName -> Blaze.Builder

247renderOid byName name

245renderOid byName name

248 = case Map.lookup (pg name) byName of

246 = case Map.lookup (pg name) byName of

249− Nothing -> error (B.unpack (pg name))

247+ Nothing -> error (B8.unpack (pg name))

250 Just (showOid . typoid -> n) -> fromString n

248 Just (showOid . typoid -> n) -> fromString n

251 ++ fromString (replicate (4 - length n) ' ')

249 ++ fromString (replicate (4 - length n) ' ')

252

250

@@ -264,20 +262,25 @@ renderTypeInfo byOid info name

264 typelem_hs_name =

262 typelem_hs_name =

265 case lookup (typname typelem_info) typeNames of

263 case lookup (typname typelem_info) typeNames of

266 Nothing -> error ( "type not found: "

264 Nothing -> error ( "type not found: "

267− ++ B.unpack( typname typelem_info)

265+ ++ B8.unpack( typname typelem_info)

268− ++ " (typelem of " ++ B.unpack (typname info)

266+ ++ " (typelem of " ++ B8.unpack (typname info)

269 ++ ")")

267 ++ ")")

270 Just x -> x

268 Just x -> x

271 in concat

269 in concat

272 [ "\n"

270 [ "\n"

273 , bs (hs name), " :: TypeInfo\n"

271 , bs (hs name), " :: TypeInfo\n"

274 , bs (hs name), " = Array {\n"

272 , bs (hs name), " = Array {\n"

275− , " typoid = ", fromString (show (typoid info)), ",\n"

273+ , " typoid = ", bs (hs name), "Oid,\n"

276− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

274+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

277− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

275+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

278 , " typname = \"", bs (typname info), "\",\n"

276 , " typname = \"", bs (typname info), "\",\n"

279 , " typelem = ", bs typelem_hs_name, "\n"

277 , " typelem = ", bs typelem_hs_name, "\n"

280 , " }\n"

278 , " }\n"

279+ , "\n"

280+ , bs (hs name), "Oid :: Oid\n"

281+ , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"

282+ , "{-# INLINE ", bs (hs name), "Oid #-}"

283+ , "\n"

281 ]

284 ]

282 | typcategory info == 'R' =

285 | typcategory info == 'R' =

283 let (Just rngsubtype_oid) = rngsubtype info

286 let (Just rngsubtype_oid) = rngsubtype info

@@ -285,31 +288,41 @@ renderTypeInfo byOid info name

285 rngsubtype_hs_name =

288 rngsubtype_hs_name =

286 case lookup (typname rngsubtype_info) typeNames of

289 case lookup (typname rngsubtype_info) typeNames of

287 Nothing -> error ( "type not found: "

290 Nothing -> error ( "type not found: "

288− ++ B.unpack (typname rngsubtype_info)

291+ ++ B8.unpack (typname rngsubtype_info)

289 ++ " (rngsubtype of "

292 ++ " (rngsubtype of "

290− ++ B.unpack (typname info) ++ ")")

293+ ++ B8.unpack (typname info) ++ ")")

291 Just x -> x

294 Just x -> x

292 in concat

295 in concat

293 [ "\n"

296 [ "\n"

294 , bs (hs name), " :: TypeInfo\n"

297 , bs (hs name), " :: TypeInfo\n"

295 , bs (hs name), " = Range {\n"

298 , bs (hs name), " = Range {\n"

296− , " typoid = ", fromString (show (typoid info)), ",\n"

299+ , " typoid = ", bs (hs name), "Oid,\n"

297− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

300+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

298− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

301+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

299 , " typname = \"", bs (typname info), "\",\n"

302 , " typname = \"", bs (typname info), "\",\n"

300 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

303 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

301 , " }\n"

304 , " }\n"

305+ , "\n"

306+ , bs (hs name), "Oid :: Oid\n"

307+ , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"

308+ , "{-# INLINE ", bs (hs name), "Oid #-}"

309+ , "\n"

302 ]

310 ]

303 | otherwise =

311 | otherwise =

304 concat

312 concat

305 [ "\n"

313 [ "\n"

306 , bs (hs name), " :: TypeInfo\n"

314 , bs (hs name), " :: TypeInfo\n"

307 , bs (hs name), " = Basic {\n"

315 , bs (hs name), " = Basic {\n"

308− , " typoid = ", fromString (show (typoid info)), ",\n"

316+ , " typoid = ", bs (hs name), "Oid,\n"

309− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

317+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

310− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

318+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

311 , " typname = \"", bs (typname info), "\"\n"

319 , " typname = \"", bs (typname info), "\"\n"

312 , " }\n"

320 , " }\n"

321+ , "\n"

322+ , bs (hs name), "Oid :: Oid\n"

323+ , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"

324+ , "{-# INLINE ", bs (hs name), "Oid #-}"

325+ , "\n"

313 ]

326 ]

314

327

315-- FIXME: add in any names that we need that we didn't specify, (i.e.

328-- FIXME: add in any names that we need that we didn't specify, (i.e.

@@ -318,7 +331,7 @@ renderTypeInfo byOid info name

318getNames :: NameMap -> TypeNames -> TypeNames

331getNames :: NameMap -> TypeNames -> TypeNames

319getNames _ x = x

332getNames _ x = x

320

333

321−bs = Blaze.fromByteString

334+bs = Blaze.byteString

322

335

323pg = fst

336pg = fst

324

337

@@ -347,6 +360,7 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

347 ( TypeInfo(..)

360 ( TypeInfo(..)

348 , staticTypeInfo

361 , staticTypeInfo

349|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

362|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

363+ ++ " , " ++ bs (hs name) ++ "Oid\n"

350 | name <- names ] ++ [longstring|

364 | name <- names ] ++ [longstring|

351 ) where

365 ) where

352

366