master..1c592eb · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on 1c592eb help sign in

.ghcinew file+16

since splitsnapshots

unifiedsplit

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

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

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

4+:set -XDoAndIfThenElse

5+:set -XOverloadedStrings

6+:set -XBangPatterns

7+:set -XViewPatterns

8+:set -XTypeOperators

10+-- for tests

11+:set -XNamedFieldPuns

12+:set -XRank2Types

13+:set -XRecordWildCards

14+:set -XPatternGuards

15+:set -XScopedTypeVariables

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

.github/workflows/haskell-ci.ymldeleted−256

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

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

2−#

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

4−#

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

6−#

7−# haskell-ci regenerate

8−#

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

10−#

11−# version: 0.17.20231110

12−#

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

14−#

15−name: Haskell-CI

16−on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

23−jobs:

24− linux:

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

26− runs-on: ubuntu-20.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:bionic

31− services:

32− postgres:

33− image: postgres:14

34− env:

35− POSTGRES_PASSWORD: postgres

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

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

38− strategy:

39− matrix:

40− include:

41− - compiler: ghc-9.8.1

42− compilerKind: ghc

43− compilerVersion: 9.8.1

44− setup-method: ghcup

45− allow-failure: false

46− - compiler: ghc-9.6.3

47− compilerKind: ghc

48− compilerVersion: 9.6.3

49− setup-method: ghcup

50− allow-failure: false

51− - compiler: ghc-9.4.8

52− compilerKind: ghc

53− compilerVersion: 9.4.8

54− setup-method: ghcup

55− allow-failure: false

56− - compiler: ghc-9.2.8

57− compilerKind: ghc

58− compilerVersion: 9.2.8

59− setup-method: ghcup

60− allow-failure: false

61− - compiler: ghc-9.0.2

62− compilerKind: ghc

63− compilerVersion: 9.0.2

64− setup-method: ghcup

65− allow-failure: false

66− - compiler: ghc-8.10.7

67− compilerKind: ghc

68− compilerVersion: 8.10.7

69− setup-method: ghcup

70− allow-failure: false

71− - compiler: ghc-8.8.4

72− compilerKind: ghc

73− compilerVersion: 8.8.4

74− setup-method: hvr-ppa

75− allow-failure: false

76− - compiler: ghc-8.6.5

77− compilerKind: ghc

78− compilerVersion: 8.6.5

79− setup-method: hvr-ppa

80− allow-failure: false

81− fail-fast: false

82− steps:

83− - name: apt

84− run: |

85− apt-get update

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

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

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

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

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

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

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

93− else

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

95− apt-get update

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

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

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

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

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

101− fi

102− env:

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

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

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

106− - name: Set PATH and environment variables

107− run: |

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

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

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

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

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

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

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

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

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

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

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

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

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

121− else

122− HC=$HCDIR/bin/$HCKIND

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

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

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

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

127− fi

128−

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

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

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

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

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

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

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

136− env:

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

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

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

140− - name: env

141− run: |

142− env

143− - name: write cabal config

144− run: |

145− mkdir -p $CABAL_DIR

146− cat >> $CABAL_CONFIG <<EOF

147− remote-build-reporting: anonymous

148− write-ghc-environment-files: never

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

150− logs-dir: $CABAL_DIR/logs

151− world-file: $CABAL_DIR/world

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

153− symlink-bindir: $CABAL_DIR/bin

154− installdir: $CABAL_DIR/bin

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

156− store-dir: $CABAL_DIR/store

157− install-dirs user

158− prefix: $CABAL_DIR

159− repository hackage.haskell.org

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

161− EOF

162− cat >> $CABAL_CONFIG <<EOF

163− program-default-options

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

165− EOF

166− cat $CABAL_CONFIG

167− - name: versions

168− run: |

169− $HC --version || true

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

171− $CABAL --version || true

172− - name: update cabal index

173− run: |

174− $CABAL v2-update -v

175− - name: install cabal-plan

176− run: |

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

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

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

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

181− rm -f cabal-plan.xz

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

183− cabal-plan --version

184− - name: checkout

185− uses: actions/checkout@v3

186− with:

187− path: source

188− - name: initial cabal.project for sdist

189− run: |

190− touch cabal.project

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

192− cat cabal.project

193− - name: sdist

194− run: |

195− mkdir -p sdist

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

197− - name: unpack

198− run: |

199− mkdir -p unpacked

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

201− - name: generate cabal.project

202− run: |

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

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

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

206− touch cabal.project

207− touch cabal.project.local

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

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

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

211− cat >> cabal.project <<EOF

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

213− EOF

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

215− cat cabal.project

216− cat cabal.project.local

217− - name: dump install plan

218− run: |

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

220− cabal-plan

221− - name: restore cache

222− uses: actions/cache/restore@v3

223− with:

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

225− path: ~/.cabal/store

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

227− - name: install dependencies

228− run: |

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

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

231− - name: build w/o tests

232− run: |

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

234− - name: build

235− run: |

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

237− - name: tests

238− run: |

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

240− - name: cabal check

241− run: |

242− cd ${PKGDIR_postgresql_simple} || false

243− ${CABAL} -vnormal check

244− - name: haddock

245− run: |

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

247− - name: unconstrained build

248− run: |

249− rm -f cabal.project.local

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

251− - name: save cache

252− uses: actions/cache/save@v3

253− if: always()

254− with:

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

256− path: ~/.cabal/store

.github/workflows/simple.ymldeleted−58

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

1−name: Simple

2−on:

3− push:

4− branches:

5− - master

6− pull_request:

7− branches:

8− - master

9−

10−jobs:

11− native:

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

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

14− strategy:

15− matrix:

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

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

18− fail-fast: false

19− timeout-minutes:

20− 60

21− steps:

22− - name: Set git to use LF

23− run: |

24− git config --global core.autocrlf false

25− git config --global core.eol lf

26−

27− - name: Set up Haskell

28− id: setup-haskell

29− uses: haskell/actions/setup@v2

30− with:

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

32− cabal-version: '3.10.2.0'

33−

34− - name: Set up PostgreSQL

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

36− id: postgres

37− with:

38− username: ci

39− password: sw0rdfish

40− database: test

41−

42− - name: Checkout

43− uses: actions/checkout@v3.0.2

44−

45− - name: Cache

46− uses: actions/cache@v2.1.3

47− with:

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

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

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

51−

52− - name: Build

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

54−

55− - name: Test

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

57− env:

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

.gitignore−6

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

7*.o

8\#*\#

9.#*

10−/CHANGELOG.md

11.cabal-sandbox/

10.cabal-sandbox/

12−.stack-work/

13cabal.sandbox.config

11cabal.sandbox.config

14−/dist-newstyle

15−.ghc.environment.*

16−cabal.project.local

17−dump-core

.travis.ymlnew file+11

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

1+language: haskell

3+ghc:

4+ - 7.6

5+ - 7.8

7+addons:

8+ postgresql: "9.3"

10+before_install:

11+ - createdb `whoami` || true

CHANGES.md+70−312

@@ -1,268 +1,26 @@

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

2−

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

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

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

6− * Drop support for GHC prior 8.6

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

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

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

10−

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

12−

13− * Support `aeson-2.2.0.0`

14−

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

16−

17− * Add `withConnect`

18−

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

20−

21− * Add foldCopyData helper function

22− Thanks to Sebastián Estrella for the implementation

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

24− * Implement support for postgresql 'interval' type

25− Thanks to Andre Marques Lee for the implementation

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

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

28−

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

30−

31− * Add `fromFieldJSONByteString`

32− Thanks to tomjaguarpaw for the implementation

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

34− * Add `attoFieldParser`

35− Thanks to Victor Nawothnig for the implementation

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

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

38− Thanks to Cary Robbins for the implementation

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

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

41− for all exception types.

42− Thanks to Elliot Cameron for the implementation

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

44− * Fix spurious aborts when retrying transactions

45− Thanks to Elliot Cameron for the implementation

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

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

48− with `Aeson` newtype.

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

50−

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

52−

53− * Define `MonadFail Ok`.

54−

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

56−

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

58− Thanks to Felix Paulusma for the implementation.

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

60−

61− * Mention GHC Generics support in the documentation.

62− Thanks to Gabriel Gonzalez for the implementation.

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

64−

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

66− Thanks to Max Amanshauser for the implementation.

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

68−

69− * fromJSONField: Include JSONPath on JSON parse errors

70− Thanks to Simon Hengel for the implementation.

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

72−

73− * No TH in implementation

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

75−

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

77−

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

79−

80− Consider a downstream library depending already both on

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

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

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

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

85−

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

87−

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

89−

90− ```haskell

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

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

93− #endif

94− ```

95−

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

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

98−

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

100− Thanks to Max Tagher for the implementation.

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

102−

103− * Add support to CockroachDB.

104− Thanks to Georte Steel.

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

106−

107− * Add Generic ConnectInfo instance

108− Thanks to Dmitry Dzhus.

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

110−

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

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

113−

114− * Add `fromFieldJSONByteString :: FieldParser ByteString`

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

116−

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

118− Thanks to Nathan Ferris Hunter.

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

120−

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

122− Thanks to Bardur Arantsson.

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

124−

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

126− These are more memory efficient

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

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

129−

130− * Documentation improvements

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

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

133−

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

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

136−

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

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

139− implementation of the fold operators, into a new

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

141−

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

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

144− reporting the issue.

145−

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

147− Matvey Aksenov.

148−

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

150−

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

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

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

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

155−

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

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

158− Valerio Riedel for reporting the issue.

159−

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

161−

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

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

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

165−

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

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

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

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

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

171− issue.

172−

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

174−

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

176− * Significantly improved the error reporting from

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

178−

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

180− to Ben Gamari.

181−

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

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

184− with Ian Wagner.

185−

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

187− to the documentation of `connectPostgreSQL`.

188−

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

190−

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

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

193− postgresql-simple against future releases of GHC.

194−

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

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

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

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

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

200−

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

202− omitting seconds, following changes made to aeson.

203−

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

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

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

207− my attention.

208−

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

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

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

212− Amit Levy.

213−

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

215−

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

217− * This is a documentation-only release

218−

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

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

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

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

223− postgresql-simple.

224−

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

226− mention the effects of environment variables on the connection

227− string parameters.

228−

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

230− haddock.

231−

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

233−

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

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

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

237−

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

239− Generics, thanks to Alexey Khudyakov.

240−

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

242−

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

1+Version 0.5.0.1 (2015-09-21)

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

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

245 that is not a whole number of hours.

3 that is not a whole number of hours.

246

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

5+Version 0.5.0.0 (2015-09-19)

248− * Removed the deprecated `BuiltinTypes` module.

6+ * Removed the deprecated BuiltinTypes module.

249

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

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

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

9+ an overloaded string, and so that the OverloadedStrings language

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

10 extension is no longer necessary, thanks to Mike Ledger.

253

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

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

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

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

256 dependencies.

14 dependencies.

257

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

16 * Rewrote the timestamp printers to use the new `Prim`

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

17+ infrastructure in bytestring-builder. The new printers should

260 be a fair bit faster.

18 be a fair bit faster.

261

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

20+ * Added support for exclusion violations to the ConstraintViolation

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

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

264

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

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

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

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

267 reduce the transitive dependencies.

25 reduce the transitive dependencies.

268

@@ -271,17 +29,17 @@

271 support UTF8 except for Mule Internal Code, the Multilingual

29 support UTF8 except for Mule Internal Code, the Multilingual

272 Extensions for Emacs. An exception should be raised upon

30 Extensions for Emacs. An exception should be raised upon

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

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

274− accommodate this requirement.

32+ accomodate this requirement.

275

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

34+ * Added Eq and Typeable instance for Connection.

277

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

36+ * Added the foldWith, forEachWith, and returningWith families of functions

279− of functions courtesy of Travis Staton.

37+ courtesy of Travis Staton.

280

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

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

282 contributions.

40 contributions.

283

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

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

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

43 are not objects or arrays, thanks to Sam Rijs.

286

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

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

@@ -291,7 +49,7 @@

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

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

292 postgresql-simple, with some adaptations.

50 postgresql-simple, with some adaptations.

293

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

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

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

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

296 Nickolay Kolev for helping to expose this issue.

54 Nickolay Kolev for helping to expose this issue.

297

@@ -299,13 +57,13 @@

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

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

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

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

301

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

60+Version 0.4.10.0 (2015-02-26)

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

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

304

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

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

306 Uimanov.

64 Uimanov.

307

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

66+Version 0.4.9.0 (2014-12-27)

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

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

310 outside of the typeclass courtesy of Tom Ellis.

68 outside of the typeclass courtesy of Tom Ellis.

311

@@ -313,13 +71,13 @@

313

314 * Fixed deprecation warnings, courtesy of Simon Hengel.

72 * Fixed deprecation warnings, courtesy of Simon Hengel.

315

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

74+Version 0.4.8.0 (2014-11-24)

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

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

318 case-insensitive package.

76 case-insensitive package.

319

320 * Added the function parseHStoreList to the HStore module.

78 * Added the function parseHStoreList to the HStore module.

321

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

80+Version 0.4.7.0 (2014-10-27)

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

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

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

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

325 contains seconds.

83 contains seconds.

@@ -339,24 +97,24 @@

339

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

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

341

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

100+Version 0.4.6.0 (2014-10-07)

343 * Added an instance ToField NominalDiffTime.

101 * Added an instance ToField NominalDiffTime.

344

102

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

103+Version 0.4.5.0 (2014-09-26)

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

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

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

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

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

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

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

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

350 for reporting the issue.

108 for reporting the issue.

351

109

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

110+Version 0.4.4.1 (2014-09-07)

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

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

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

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

355 Dmitry Dzhus for reporting the issue.

113 Dmitry Dzhus for reporting the issue.

356

114

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

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

358

116

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

117+Version 0.4.4.0 (2014-08-26)

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

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

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

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

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

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

@@ -365,7 +123,7 @@

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

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

366 a documentation typo.

124 a documentation typo.

367

125

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

126+Version 0.4.3.0 (2014-07-10)

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

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

370 This means we are using threadWaitRead and threadWaitWrite to

128 This means we are using threadWaitRead and threadWaitWrite to

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

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

@@ -379,7 +137,7 @@

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

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

380 isn't perfectly achieved as of yet.

138 isn't perfectly achieved as of yet.

381

139

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

140+Version 0.4.2.3 (2014-06-04)

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

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

384

142

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

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

@@ -390,13 +148,13 @@

390

148

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

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

392

150

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

151+Version 0.4.2.2 (2014-05-15)

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

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

395

153

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

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

397 foldWithOptions, executeMany, and returning operators.

155 foldWithOptions, executeMany, and returning operators.

398

156

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

157+Version 0.4.2.1 (2014-03-27)

400 * Fixed bug in Values syntax generation

158 * Fixed bug in Values syntax generation

401

159

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

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

@@ -404,17 +162,17 @@

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

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

405 for QualifiedIdentifier.

163 for QualifiedIdentifier.

406

164

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

165+Version 0.4.2.0 (2014-03-22)

408 * Added ToField and FromField instances for the scientific package

166 * Added ToField and FromField instances for the scientific package

409

167

410 * Changed the Identifier and QualifiedIdentifier to use Text in

168 * Changed the Identifier and QualifiedIdentifier to use Text in

411 order to avoid encoding errors. Technically this requires a

169 order to avoid encoding errors. Technically this requires a

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

170+ major verson bump, but let's pretend 0.4.1.0 didn't happen.

413

171

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

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

415 and tweaked error messages.

173 and tweaked error messages.

416

174

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

175+Version 0.4.1.0 (2014-03-22)

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

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

419 Francesco Mazzoli

177 Francesco Mazzoli

420

178

@@ -426,17 +184,17 @@

426 more general than executeMany and returning. See the

184 more general than executeMany and returning. See the

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

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

428

186

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

187+Version 0.4.0.2 (2014-01-12)

430 * Tweaked C preprocessor directive to be more portable

188 * Tweaked C preprocessor directive to be more portable

431

189

432 * Tweaked testsuite for compatibility with aeson-0.7

190 * Tweaked testsuite for compatibility with aeson-0.7

433

191

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

192+Version 0.4.0.1 (2013-12-21)

435 * Relaxed dependency on aeson to >= 0.6

193 * Relaxed dependency on aeson to >= 0.6

436

194

437 * Update the documentation of `fromField`

195 * Update the documentation of `fromField`

438

196

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

197+Version 0.4.0.0 (2013-12-21)

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

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

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

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

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

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

@@ -452,15 +210,15 @@

452

210

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

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

454

212

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

213+Version 0.3.10.0 (2013-12-17)

456 * Added the queryWith function, courtesy of Leonid Onokhov

214 * Added the queryWith function, courtesy of Leonid Onokhov

457

215

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

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

459

217

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

218+Version 0.3.9.1 (2013-10-28)

461 * Removed dependency on hashable

219 * Removed dependency on hashable

462

220

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

221+Version 0.3.9.0 (2013-10-27)

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

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

465 courtesy of Bas van Dijk.

223 courtesy of Bas van Dijk.

466

224

@@ -470,16 +228,16 @@

470 * Added the fromBinary, fromHStoreMap, and fromHStoreList newtype

228 * Added the fromBinary, fromHStoreMap, and fromHStoreList newtype

471 unwrapper functions, courtesy of Bas van Dijk.

229 unwrapper functions, courtesy of Bas van Dijk.

472

230

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

231+Version 0.3.8.0 (2013-10-11)

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

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

475

233

476 * Added `Notification.getBackendPID`.

234 * Added `Notification.getBackendPID`.

477

235

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

236+Version 0.3.7.1 (2013-09-12)

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

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

480 courtesy of Michael Snoyman

238 courtesy of Michael Snoyman

481

239

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

240+Version 0.3.7.0 (2013-09-11)

483 * Added `aeson` as a dependency.

241 * Added `aeson` as a dependency.

484

242

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

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

@@ -500,7 +258,7 @@

500

258

501 * Various documentation fixes.

259 * Various documentation fixes.

502

260

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

261+Version 0.3.6.0 (2013-08-19)

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

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

505 Manuel Gómez.

263 Manuel Gómez.

506

264

@@ -511,14 +269,14 @@

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

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

512 this change.

270 this change.

513

271

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

272+Version 0.3.5.0 (2013-08-09)

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

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

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

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

517

275

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

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

519 documentation for the LargeObjects module.

277 documentation for the LargeObjects module.

520

278

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

279+Version 0.3.4.0 (2013-07-23)

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

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

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

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

524 module.

282 module.

@@ -527,49 +285,49 @@

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

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

528 the connection's file descriptor from libpq.

286 the connection's file descriptor from libpq.

529

287

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

288+Version 0.3.3.2 (2013-06-18)

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

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

532 the Query type, courtesy of Joey Adams.

290 the Query type, courtesy of Joey Adams.

533

291

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

292+Version 0.3.3.1 (2013-06-06)

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

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

536 polling loop, courtesy of Joey Adams.

294 polling loop, courtesy of Joey Adams.

537

295

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

296+Version 0.3.3.0 (2013-05-29)

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

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

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

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

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

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

542 work on these issues.

300 work on these issues.

543

301

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

302+Version 0.3.2.0 (2013-05-20)

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

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

546 of Joey Adams

304 of Joey Adams

547

305

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

306+Version 0.3.1.2 (2013-04-29)

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

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

550

308

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

309+Version 0.3.1.1 (2013-04-29)

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

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

553 Meier

311 Meier

554

312

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

313+Version 0.3.1.0 (2013-04-26)

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

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

557

315

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

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

559

317

560 * Improved documentation of the FromField module.

318 * Improved documentation of the FromField module.

561

319

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

320+Version 0.3.0.1 (2013-03-26)

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

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

564 silently failed to render in Haddock.

322 silently failed to render in Haddock.

565

323

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

324+Version 0.3.0.0 (2013-03-25)

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

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

568 for his work on this feature.

326 for his work on this feature.

569

327

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

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

571 convenient and efficient access to the pg_type metatable. This

329 convenient and efficient access to the pg_type metatable. This

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

330+ replaced the older typename cache, and was neccesary to properly

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

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

574 work on this feature.

332 work on this feature.

575

333

@@ -605,33 +363,33 @@

605 now stripped out.

363 now stripped out.

606

364

607

365

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

366+Version 0.2.4.1 (2012-08-29)

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

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

610 pointing this out.

368 pointing this out.

611

369

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

370+Version 0.2.4.0 (2012-08-23)

613 * Added the `withTransactionSerializable` and `withTransactionModeRetry`

371 * Added the `withTransactionSerializable` and `withTransactionModeRetry`

614 operators, thanks to Joey Adams.

372 operators, thanks to Joey Adams.

615

373

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

374+Version 0.2.3.0 (2012-08-09)

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

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

618

376

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

377+Version 0.2.2.0 (2012-07-26)

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

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

621

379

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

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

623

381

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

382+Version 0.2.1.0 (2012-07-23)

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

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

626

384

627 * Added a type synonym for FieldParser

385 * Added a type synonym for FieldParser

628

386

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

387+Version 0.2.0.1 (2012-06-21)

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

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

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

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

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

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

633

391

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

392+Version 0.2: (2012-06-19)

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

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

636 broken even though it will still compile.

394 broken even though it will still compile.

637

395

@@ -640,16 +398,16 @@

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

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

641

399

642

400

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

401+Version 0.1.4.3: (2012-06-10)

644 * Fix language extensions for compatibility with GHC 7.0

402 * Fix language extensions for compatibility with GHC 7.0

645

403

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

404+Version 0.1.4.2: (2012-06-10)

647 * Fix a wayward dependency on Text.

405 * Fix a wayward dependency on Text.

648

406

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

407+Version 0.1.4.1: (2012-06-10)

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

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

651

409

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

410+Version 0.1.4: (2012-06-10)

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

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

654

412

655 * Reworked support for the Time types.

413 * Reworked support for the Time types.

@@ -661,7 +419,7 @@

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

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

662

420

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

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

664− that accommodate PostgreSQL's infinities.

422+ that accomodate PostgreSQL's infinities.

665

423

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

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

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

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

@@ -674,13 +432,13 @@

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

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

675

433

676

434

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

435+Version 0.1.3: (2012-05-30)

678 * Made ZonedTime an instance of FromField and ToField

436 * Made ZonedTime an instance of FromField and ToField

679

437

680 * Added getNotificationNonBlocking

438 * Added getNotificationNonBlocking

681

439

682

440

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

441+Version 0.1.2: (2012-05-09)

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

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

685 PostgreSQL 8 courtesy of Joey Adams.

443 PostgreSQL 8 courtesy of Joey Adams.

686

444

@@ -693,7 +451,7 @@

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

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

694

452

695

453

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

454+Version 0.1.1: (2012-05-06)

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

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

698 LargeObjects modules

456 LargeObjects modules

699

457

@@ -702,7 +460,7 @@

702 * Fixed a bug relating to handling the transaction level

460 * Fixed a bug relating to handling the transaction level

703

461

704

462

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

463+Version 0.1: (2012-05-04)

706 * Renamed several modules, typeclasses, and functions:

464 * Renamed several modules, typeclasses, and functions:

707

465

708 QueryParams (renderParams) -> ToRow (toRow)

466 QueryParams (renderParams) -> ToRow (toRow)

CONTRIBUTING.mddeleted−13

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

1−Patches welcome!

2−

3−- If you are only going to bump bounds:

4− - If it's really **only bounds**, please simply open an issue (so you'll have a URL to refer to). I have a semi-automated process to make revisions, pull requests only disturb it.

5− - If patch includes **source code change** (i.e. I'll need to make a release), and it's a patch to support **newer base/GHC version**:

6− - Amend `tested-with` to include that GHC

7− - Regenerate `.github/workflows/haskell-ci.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci))

8−

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

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

11−

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

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

CONTRIBUTORS−7

@@ -27,10 +27,3 @@ Travis Staton <hello@travisstaton.com>

27Sam Rijs <srijs@airpost.net>

28Janne Hellsten <jjhellst@gmail.com>

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

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

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

32−Amit Levy <amit@amitlevy.com>

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

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

35−Erik Hesselink <hesselink@gmail.com>

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

README.md+3

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

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

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

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

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

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

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

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

bench/Select.hsdeleted−32

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

1−{-# LANGUAGE OverloadedStrings #-}

2−module Main where

3−

4−import Database.PostgreSQL.Simple

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

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

7−

8−import System.Environment (getArgs)

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

10−import qualified Data.Vector.Unboxed as VU

11−

12−main :: IO ()

13−main = do

14− args <- getArgs

15− conn <- connectPostgreSQL ""

16− case args of

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

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

19− print (process result)

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

21− -- dummy column

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

23− print (process' result)

24− _ -> do

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

26− print (process result)

27−

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

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

30−

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

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

cabal.haskell-cideleted−5

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

1−branches: master

2−postgresql: True

3−

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

5−-- osx: 8.4.4

cabal.projectdeleted−4

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

1−packages: .

2−tests: true

3−

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

cabal.project.local.windeleted−4

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

1−constraints: these -assoc

2−

3−package postgresql-libpq

4− flags: -use-pkg-config

postgresql-simple.cabal+96−153

@@ -1,175 +1,118 @@

1−cabal-version: 1.12

2−name: postgresql-simple

1+Name: postgresql-simple

3−version: 0.7.0.0

2+Version: 0.5.0.1

4−x-revision: 1

5−synopsis: Mid-Level PostgreSQL client library

3+Synopsis: Mid-Level PostgreSQL client library

6−description:

4+Description:

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

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

6+License: BSD3

7+License-file: LICENSE

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

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

12+Category: Database

13+Build-type: Simple

9−license: BSD3

15+Cabal-version: >= 1.9.2

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

20extra-source-files:

17extra-source-files:

21− CHANGES.md

22− CONTRIBUTORS

18+ CONTRIBUTORS

23− test/results/malformed-input.expected

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

26−tested-with:

20+Library

27− GHC ==8.6.5

21+ hs-source-dirs: src

28− || ==8.8.4

22+ Exposed-modules:

29− || ==8.10.7

23+ Database.PostgreSQL.Simple

30− || ==9.0.2

24+ Database.PostgreSQL.Simple.Arrays

31− || ==9.2.8

25+ Database.PostgreSQL.Simple.Copy

32− || ==9.4.8

26+ Database.PostgreSQL.Simple.FromField

33− || ==9.6.3

27+ Database.PostgreSQL.Simple.FromRow

34− || ==9.8.1

28+ Database.PostgreSQL.Simple.LargeObjects

29+ Database.PostgreSQL.Simple.HStore

30+ Database.PostgreSQL.Simple.HStore.Internal

31+ Database.PostgreSQL.Simple.Notification

32+ Database.PostgreSQL.Simple.Ok

33+ Database.PostgreSQL.Simple.Range

34+ Database.PostgreSQL.Simple.SqlQQ

35+ Database.PostgreSQL.Simple.Time

36+ Database.PostgreSQL.Simple.Time.Internal

37+ Database.PostgreSQL.Simple.ToField

38+ Database.PostgreSQL.Simple.ToRow

39+ Database.PostgreSQL.Simple.Transaction

40+ Database.PostgreSQL.Simple.TypeInfo

41+ Database.PostgreSQL.Simple.TypeInfo.Macro

42+ Database.PostgreSQL.Simple.TypeInfo.Static

43+ Database.PostgreSQL.Simple.Types

44+ Database.PostgreSQL.Simple.Errors

45+-- Other-modules:

46+ Database.PostgreSQL.Simple.Internal

36−library

37− default-language: Haskell2010

38− hs-source-dirs: src

39− exposed-modules:

48+ Other-modules:

40− Database.PostgreSQL.Simple

49+ Database.PostgreSQL.Simple.Compat

41− Database.PostgreSQL.Simple.Arrays

42− Database.PostgreSQL.Simple.Copy

43− Database.PostgreSQL.Simple.Cursor

44− Database.PostgreSQL.Simple.Errors

45− Database.PostgreSQL.Simple.FromField

46− Database.PostgreSQL.Simple.FromRow

47− Database.PostgreSQL.Simple.HStore

48− Database.PostgreSQL.Simple.HStore.Internal

50+ Database.PostgreSQL.Simple.HStore.Implementation

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

51+ Database.PostgreSQL.Simple.Time.Implementation

54− Database.PostgreSQL.Simple.Range

55− Database.PostgreSQL.Simple.SqlQQ

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

56− Database.PostgreSQL.Simple.Time

57− Database.PostgreSQL.Simple.Time.Internal

58− Database.PostgreSQL.Simple.ToField

59− Database.PostgreSQL.Simple.ToRow

60− Database.PostgreSQL.Simple.Transaction

61− Database.PostgreSQL.Simple.TypeInfo

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

62− Database.PostgreSQL.Simple.TypeInfo.Macro

63− Database.PostgreSQL.Simple.TypeInfo.Static

54+ Database.PostgreSQL.Simple.TypeInfo.Types

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

79− build-depends:

56+ Build-depends:

80− base >=4.12.0.0 && <4.20

81− , bytestring >=0.10.8.2 && <0.13

82− , containers >=0.6.0.1 && <0.7

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

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

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

86− , transformers >=0.5.6.2 && <0.7

87−

88− -- Other dependencies

89− build-depends:

90− aeson >=2.1.2.1 && <2.3

57+ aeson >= 0.6,

91− , attoparsec >=0.14.4 && <0.15

58+ attoparsec >= 0.10.3,

59+ base < 5,

60+ bytestring >= 0.9,

61+ bytestring-builder,

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

62+ case-insensitive,

63+ containers,

93− , hashable >=1.4.3.0 && <1.5

64+ hashable,

94− , Only >=0.1 && <0.1.1

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

65+ postgresql-libpq >= 0.9 && < 0.10,

96− , scientific >=0.3.7.0 && <0.4

66+ template-haskell,

67+ text >= 0.11.1,

68+ time,

69+ transformers,

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

70+ uuid-types >= 1.0.0,

71+ scientific,

98− , vector >=0.13.0.0 && <0.14

72+ vector

100− default-extensions:

101− BangPatterns

102− DoAndIfThenElse

103− OverloadedStrings

74+ extensions: DoAndIfThenElse, OverloadedStrings, BangPatterns, ViewPatterns

104− TypeOperators

75+ TypeOperators

105− ViewPatterns

106

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

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

108

109source-repository head

79source-repository head

110 type: git

80 type: git

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

81+ location: http://github.com/lpsmith/postgresql-simple

112

113−test-suite inspection

83+source-repository this

114− default-language: Haskell2010

84+ type: git

115− type: exitcode-stdio-1.0

85+ location: http://github.com/lpsmith/postgresql-simple

116− hs-source-dirs: test

86+ tag: v0.5.0.1

117− main-is: Inspection.hs

118− build-depends:

119− base

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

121− , postgresql-libpq

122− , postgresql-simple

123− , tasty

124− , tasty-hunit

125

126test-suite test

88test-suite test

127− default-language: Haskell2010

128− type: exitcode-stdio-1.0

89+ type: exitcode-stdio-1.0

90+

129− hs-source-dirs: test

91+ hs-source-dirs: test

130− main-is: Main.hs

92+ main-is: Main.hs

131 other-modules:

93 other-modules:

132 Common

94 Common

133− Exception

134− Interval

135 Notify

95 Notify

136 Serializable

96 Serializable

137 Time

97 Time

138

139− ghc-options: -threaded

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

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

149− build-depends:

101+ extensions: NamedFieldPuns

150− aeson

102+ , OverloadedStrings

151− , base

103+ , Rank2Types

152− , base16-bytestring

104+ , RecordWildCards

153− , bytestring

105+ , PatternGuards

154− , case-insensitive

106+ , ScopedTypeVariables

155− , containers

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

157− , filepath

158− , HUnit

159− , postgresql-simple

160− , tasty

161− , tasty-golden

162− , tasty-hunit

163− , text

164− , time-compat

165− , vector

166

107

167−benchmark select

168− default-language: Haskell2010

169− type: exitcode-stdio-1.0

170− hs-source-dirs: bench

171− main-is: Select.hs

172− build-depends:

108+ build-depends: base

173− base

109+ , aeson

110+ , base16-bytestring

111+ , bytestring

112+ , containers

113+ , cryptohash

114+ , HUnit

174− , postgresql-simple

115+ , postgresql-simple

116+ , text

117+ , time

175− , vector

118+ , vector

sdist.shdeleted−25

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

1−#!/bin/bash

2−

3−echo "Generating CHANGELOG.md"

4−echo

5−

6−cat <<HEADER > CHANGELOG.md

7−For the full changelog, see

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

9−

10−HEADER

11−

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

13−

14−cat CHANGELOG.md

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

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

17−cabal sdist

18−cd dist

19−wc *.tar.gz

20−gunzip *.gz

21−wc *.tar

22−zopfli *.tar

23−wc *.tar.gz

24−cd ..

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

src/Database/PostgreSQL/Simple.hs+114−37

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

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67− , SomePostgreSqlException(..)

68 , SqlError(..)

67 , SqlError(..)

69 , PQ.ExecStatus(..)

68 , PQ.ExecStatus(..)

70 , FormatError(..)

69 , FormatError(..)

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

74 , Base.connectPostgreSQL

73 , Base.connectPostgreSQL

75 , Base.close

74 , Base.close

76 , Base.connect

75 , Base.connect

77− , Base.withConnect

78 , Base.ConnectInfo(..)

76 , Base.ConnectInfo(..)

79 , Base.defaultConnectInfo

77 , Base.defaultConnectInfo

80 , Base.postgreSQLConnectionString

78 , Base.postgreSQLConnectionString

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

120 , formatQuery

118 , formatQuery

121 ) where

119 ) where

122

120

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

121+import Data.ByteString.Builder

122+ ( Builder, byteString, char8, intDec )

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

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

125import Control.Exception as E

124import Control.Exception as E

125+import Control.Monad (foldM, unless, when, forM_)

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

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

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

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

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

140import Database.PostgreSQL.Simple.Transaction

139import 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+import qualified Control.Monad.Trans.State.Strict as SL

146+import Control.Monad.IO.Class (liftIO)

143

147

144

148

145-- | Format a query string.

149-- | Format a query string.

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

278 skipSpace = B.dropWhile isSpace_ascii

282 skipSpace = B.dropWhile isSpace_ascii

279

283

280

284

285+

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

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

282buildQuery conn q template xs =

287buildQuery conn q template xs =

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

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

284 where split s =

289 where split s =

285− -- This part escapes double '??'s to make literal '?'s possible

290+ let (h,t) = B.break (=='?') s

286− -- in PostgreSQL queries using the JSON operators: @?@, @?|@ and @?&@

287− let (h,t) = breakOnSingleQuestionMark s

288 in byteString h

291 in byteString h

289 : if B.null t

292 : if B.null t

290 then []

293 then []

291 else split (B.tail t)

294 else split (B.tail t)

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

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

293 zipParams [t] [] = t

296 zipParams [t] [] = t

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

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

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

298+ " '?' characters, but " ++

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

299 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

306

300

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

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

308-- expected to return results.

302-- expected to return results.

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

340-- @

334-- @

341-- executeMany c [sql|

335-- executeMany c [sql|

342-- UPDATE sometable

336-- UPDATE sometable

343−-- SET y = upd.y

337+-- SET sometable.y = upd.y

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

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

345-- WHERE sometable.x = upd.x

339-- WHERE sometable.x = upd.x

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

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

347-- @

341-- @

348

342

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

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

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

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

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

368returning = returningWith fromRow

362returning = returningWith fromRow

369

363

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

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

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

372returningWith _ _ _ [] = return []

365returningWith _ _ _ [] = return []

373returningWith parser conn q qs = do

366returningWith parser conn q qs = do

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

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

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

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

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

535 -> IO a

528 -> IO a

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

529+foldWithOptions_ opts conn query a f = doFold opts fromRow conn query query a f

537

530

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

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

539foldWithOptionsAndParser_ :: FoldOptions

532foldWithOptionsAndParser_ :: FoldOptions

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

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

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

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

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

545 -> IO a

538 -> IO a

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

539+foldWithOptionsAndParser_ opts parser conn query a f = doFold opts parser conn query query a f

547

540

548doFold :: FoldOptions

541doFold :: FoldOptions

549 -> RowParser row

542 -> RowParser row

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

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

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

572 -- Not sure what this means.

565 -- Not sure what this means.

573 where

566 where

574− declare =

567+ declare = do

575− declareCursor conn q

568+ name <- newTempName conn

576− fetch cursor a =

569+ _ <- execute_ conn $ mconcat

577− foldForwardWithParser cursor parser chunkSize f a

570+ [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]

578−

571+ return name

572+ close name =

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

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

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

576+ unless (isFailedTransactionError ex) $ throwIO ex

577+

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

578+ go = bracket declare close $ \(Query name) ->

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

579+ let q = toByteString (byteString "FETCH FORWARD "

580+ <> intDec chunkSize

581+ <> byteString " FROM "

582+ <> byteString name

583+ )

584+ loop = do

585+ result <- liftIO (exec conn q)

586+ status <- liftIO (PQ.resultStatus result)

581− \r -> case r of

587+ case status of

582− Left x -> return x

588+ PQ.TuplesOk -> do

583− Right x -> loop x

589+ nrows <- liftIO (PQ.ntuples result)

590+ ncols <- liftIO (PQ.nfields result)

591+ when (nrows > 0) $ do

592+ forM_ [0..(nrows-1)] $ \row -> do

593+ x <- liftIO (getRowWith parser row ncols conn (Query q) result)

594+ a <- get

595+ a' <- liftIO (f a x)

596+ put a'

597+ loop

598+ _ -> liftIO (throwResultError "fold" result status)

584− in loop a0

599+ in SL.execStateT loop a0

585

600

586-- FIXME: choose the Automatic chunkSize more intelligently

601-- FIXME: choose the Automatic chunkSize more intelligently

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

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

@@ -631,6 +646,68 @@ forEachWith_ :: RowParser r

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

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

632{-# INLINE forEachWith_ #-}

647{-# INLINE forEachWith_ #-}

633

648

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

650+forM' lo hi m = loop hi []

651+ where

652+ loop !n !as

653+ | n < lo = return as

654+ | otherwise = do

655+ a <- m n

656+ loop (n-1) (a:as)

657+

658+finishQuery :: FromRow r => Connection -> Query -> PQ.Result -> IO [r]

659+finishQuery = finishQueryWith fromRow

660+

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

662+finishQueryWith parser conn q result = do

663+ status <- PQ.resultStatus result

664+ case status of

665+ PQ.EmptyQuery ->

666+ throwIO $ QueryError "query: Empty query" q

667+ PQ.CommandOk ->

668+ throwIO $ QueryError "query resulted in a command response" q

669+ PQ.TuplesOk -> do

670+ nrows <- PQ.ntuples result

671+ ncols <- PQ.nfields result

672+ forM' 0 (nrows-1) $ \row ->

673+ getRowWith parser row ncols conn q result

674+ PQ.CopyOut ->

675+ throwIO $ QueryError "query: COPY TO is not supported" q

676+ PQ.CopyIn ->

677+ throwIO $ QueryError "query: COPY FROM is not supported" q

678+ PQ.BadResponse -> throwResultError "query" result status

679+ PQ.NonfatalError -> throwResultError "query" result status

680+ PQ.FatalError -> throwResultError "query" result status

681+

682+getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> Query -> PQ.Result -> IO r

683+getRowWith parser row ncols conn q result = do

684+ let rw = Row row result

685+ let unCol (PQ.Col x) = fromIntegral x :: Int

686+ okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn

687+ case okvc of

688+ Ok (val,col) | col == ncols -> return val

689+ | otherwise -> do

690+ vals <- forM' 0 (ncols-1) $ \c -> do

691+ tinfo <- getTypeInfo conn =<< PQ.ftype result c

692+ v <- PQ.getvalue result row c

693+ return ( tinfo

694+ , fmap ellipsis v )

695+ throw (ConversionFailed

696+ (show (unCol ncols) ++ " values: " ++ show vals)

697+ Nothing

698+ ""

699+ (show (unCol col) ++ " slots in target type")

700+ "mismatch between number of columns to \

701+ \convert and number in target type")

702+ Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"

703+ Errors [x] -> throwIO x

704+ Errors xs -> throwIO $ ManyErrors xs

705+

706+ellipsis :: ByteString -> ByteString

707+ellipsis bs

708+ | B.length bs > 15 = B.take 10 bs `B.append` "[...]"

709+ | otherwise = bs

710+

634

711

635-- $use

712-- $use

636--

713--

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

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

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

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

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

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

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

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

982+-- represent a @SMALLINT@, so it is considered compatble with those types.

906--

983--

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

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

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

985-- 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,13 +12,31 @@ module Database.PostgreSQL.Simple.Compat

12 ) where

14import qualified Control.Exception as E

15+import Data.Monoid

15import Data.ByteString (ByteString)

16import Data.ByteString (ByteString)

16import Data.ByteString.Lazy (toStrict)

17import Data.ByteString.Lazy (toStrict)

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

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

19+

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

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

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

22+#else

23+import Data.Scientific (scientificBuilder)

24+#endif

25+

26+#if __GLASGOW_HASKELL__ >= 702

19import System.IO.Unsafe (unsafeDupablePerformIO)

27import System.IO.Unsafe (unsafeDupablePerformIO)

28+#elif __GLASGOW_HASKELL__ >= 611

29+import GHC.IO (unsafeDupablePerformIO)

30+#else

31+import GHC.IOBase (unsafeDupablePerformIO)

32+#endif

33+

20import Data.Fixed (Pico)

34import Data.Fixed (Pico)

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

21import Data.Fixed (Fixed(MkFixed))

36import Data.Fixed (Fixed(MkFixed))

37+#else

38+import Unsafe.Coerce (unsafeCoerce)

39+#endif

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

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

24--

42--

@@ -28,14 +46,40 @@ import Data.Fixed (Fixed(MkFixed))

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

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

29-- don't need that polymorphism.

47-- don't need that polymorphism.

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

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

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

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

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

32{-# INLINE mask #-}

56{-# 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+

34toByteString :: Builder -> ByteString

66toByteString :: Builder -> ByteString

35toByteString x = toStrict (toLazyByteString x)

67toByteString x = toStrict (toLazyByteString x)

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

70+

37toPico :: Integer -> Pico

71toPico :: Integer -> Pico

38toPico = MkFixed

72toPico = MkFixed

40fromPico :: Pico -> Integer

74fromPico :: Pico -> Integer

41fromPico (MkFixed i) = i

75fromPico (MkFixed i) = i

76+

77+#else

78+

79+toPico :: Integer -> Pico

80+toPico = unsafeCoerce

81+

82+fromPico :: Pico -> Integer

83+fromPico = unsafeCoerce

84+

85+#endif

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

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

9-- Stability: experimental

10--

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

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

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

13-- more information.

14--

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

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

32 ( copy

33 , copy_

34 , CopyOutResult(..)

35− , foldCopyData

36 , getCopyData

35 , getCopyData

37 , putCopyData

36 , putCopyData

38 , putCopyEnd

37 , putCopyEnd

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

49import qualified Database.PostgreSQL.LibPQ as PQ

48import qualified Database.PostgreSQL.LibPQ as PQ

50import Database.PostgreSQL.Simple

49import Database.PostgreSQL.Simple

51import Database.PostgreSQL.Simple.Types

50import Database.PostgreSQL.Simple.Types

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

51+import Database.PostgreSQL.Simple.Internal

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

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

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

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

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

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

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

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

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

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

61copy conn template qs = do

60copy conn template qs = do

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

76doCopy funcName conn template q = do

75doCopy funcName conn template q = do

77 result <- exec conn q

76 result <- exec conn q

78 status <- PQ.resultStatus result

77 status <- PQ.resultStatus result

79− let errMsg msg = throwIO $ QueryError

78+ let err = throwIO $ QueryError

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

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

81 template

80 template

82− let err = errMsg $ show status

83 case status of

81 case status of

84 PQ.EmptyQuery -> err

82 PQ.EmptyQuery -> err

85 PQ.CommandOk -> err

83 PQ.CommandOk -> err

86 PQ.TuplesOk -> err

84 PQ.TuplesOk -> err

87 PQ.CopyOut -> return ()

85 PQ.CopyOut -> return ()

88 PQ.CopyIn -> return ()

86 PQ.CopyIn -> return ()

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

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

91 PQ.BadResponse -> throwResultError funcName result status

87 PQ.BadResponse -> throwResultError funcName result status

92 PQ.NonfatalError -> throwResultError funcName result status

88 PQ.NonfatalError -> throwResultError funcName result status

93 PQ.FatalError -> throwResultError funcName result status

89 PQ.FatalError -> throwResultError funcName result status

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

101 deriving (Eq, Typeable, Show)

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

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

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

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

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

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

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

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

252 consumeResults pqconn

224 consumeResults pqconn

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

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

254 case P.parseOnly rowCount cmdStat of

226 case P.parseOnly rowCount cmdStat of

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

256− fail $ errCmdStatusFmt

227+ Left _ -> fail errCmdStatusFmt

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

258 Right n -> return $! n

228 Right n -> return $! n

259 where

229 where

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

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

src/Database/PostgreSQL/Simple/Cursor.hsdeleted−98

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

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−------------------------------------------------------------------------------

4−-- |

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

8−-- License: BSD3

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

10−--

11−------------------------------------------------------------------------------

12−

13−module Database.PostgreSQL.Simple.Cursor

14− (

15− -- * Types

16− Cursor

17− -- * Cursor management

18− , declareCursor

19− , closeCursor

20− -- * Folding over rows from a cursor

21− , foldForward

22− , foldForwardWithParser

23− ) where

24−

25−import Data.ByteString.Builder (intDec)

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

27−import Control.Exception as E

28−import Control.Monad (unless, void)

29−import Data.Monoid (mconcat)

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

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

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

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

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

35−import Database.PostgreSQL.Simple.Transaction

36−import qualified Database.PostgreSQL.LibPQ as PQ

37−

38−-- | Cursor within a transaction.

39−data Cursor = Cursor !Query !Connection

40−

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

42−-- unique name for the given connection.

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

44−declareCursor conn q = do

45− name <- newTempName conn

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

47− return $ Cursor name conn

48−

49−-- | Close the given cursor.

50−closeCursor :: Cursor -> IO ()

51−closeCursor (Cursor name conn) =

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

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

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

55− unless (isFailedTransactionError ex) $ throwIO ex

56−

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

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

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

60−-- 'Right' value is returned.

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

62−foldForwardWithParser (Cursor name conn) parser chunkSize f a0 = do

63− let q = "FETCH FORWARD "

64− <> (toByteString $ intDec chunkSize)

65− <> " FROM "

66− <> fromQuery name

67− result <- exec conn q

68− status <- PQ.resultStatus result

69− case status of

70− PQ.TuplesOk -> do

71− nrows <- PQ.ntuples result

72− ncols <- PQ.nfields result

73− if nrows > 0

74− then do

75− let inner a row = do

76− x <- getRowWith parser row ncols conn result

77− f a x

78− Right <$> foldM' inner a0 0 (nrows - 1)

79− else

80− return $ Left a0

81− _ -> throwResultError "foldForwardWithParser" result status

82−

83−-- | Fold over a chunk of rows, calling the supplied fold-like function

84−-- on each row as it is received. In case the cursor is exhausted,

85−-- a 'Left' value is returned, otherwise a 'Right' value is returned.

86−foldForward :: FromRow r => Cursor -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)

87−foldForward cursor = foldForwardWithParser cursor fromRow

88−

89−

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

91−foldM' f a lo hi = loop a lo

92− where

93− loop x !n

94− | n > hi = return x

95− | otherwise = do

96− x' <- f x n

97− loop x' (n+1)

98−{-# INLINE foldM' #-}

src/Database/PostgreSQL/Simple/Errors.hs+11−12

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

25 )

26 where

28+import Control.Applicative

28import Control.Exception as E

29import Control.Exception as E

30import Data.Attoparsec.ByteString.Char8

31import Data.Attoparsec.ByteString.Char8

@@ -59,18 +60,16 @@ data ConstraintViolation

59 deriving (Show, Eq, Ord, Typeable)

60 deriving (Show, Eq, Ord, Typeable)

61-- Default instance should be enough

62-- Default instance should be enough

62−instance Exception ConstraintViolation where

63+instance Exception ConstraintViolation

63− toException = postgresqlExceptionToException

64− fromException = postgresqlExceptionFromException

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

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

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

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

69--

68--

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

69+-- > createUser = catchJust constraintViolation catcher $ execute conn ...

71-- > where

70-- > where

72−-- > handler (UniqueViolation "user_login_key") = ...

71+-- > catcher UniqueViolation "user_login_key" = ...

73−-- > handler _ = ...

72+-- > catcher _ = ...

74constraintViolation :: SqlError -> Maybe ConstraintViolation

73constraintViolation :: SqlError -> Maybe ConstraintViolation

75constraintViolation e =

74constraintViolation e =

76 case sqlState e of

75 case sqlState e of

@@ -85,16 +84,16 @@ constraintViolation e =

86-- | Like constraintViolation, but also packs original SqlError.

85-- | Like constraintViolation, but also packs original SqlError.

87--

86--

88−-- > createUser = handleJust constraintViolationE handler $ execute conn ...

87+-- > createUser = catchJust constraintViolationE catcher $ execute conn ...

89-- > where

88-- > where

90−-- > handler (_, UniqueViolation "user_login_key") = ...

89+-- > catcher (_, UniqueViolation "user_login_key") = ...

91−-- > handler (e, _) = throwIO e

90+-- > catcher (e, _) = throwIO e

92--

91--

93constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)

92constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)

94constraintViolationE e = fmap ((,) e) $ constraintViolation e

93constraintViolationE e = fmap ((,) e) $ constraintViolation e

96-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws

95-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws

97−-- on fail. Provides alternative interface to 'E.handleJust'

96+-- on fail. Provides alternative interface to catchJust

98--

97--

99-- > createUser = catchViolation catcher $ execute conn ...

98-- > createUser = catchViolation catcher $ execute conn ...

100-- > where

99-- > where

@@ -125,7 +124,7 @@ parseMaybe p b = either (const Nothing) Just $ parseOnly p b

125------------------------------------------------------------------------

124------------------------------------------------------------------------

126-- Error predicates

125-- Error predicates

127--

126--

128−-- https://www.postgresql.org/docs/9.5/static/errcodes-appendix.html

127+-- http://www.postgresql.org/docs/current/static/errcodes-appendix.html

129

128

130isSerializationError :: SqlError -> Bool

129isSerializationError :: SqlError -> Bool

131isSerializationError = isSqlState "40001"

130isSerializationError = isSqlState "40001"

src/Database/PostgreSQL/Simple/FromField.hs+77−152

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

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

2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

4−{-# LANGUAGE RecordWildCards #-}

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

5−{-# LANGUAGE PolyKinds #-}

7{- |

6{- |

8Module: Database.PostgreSQL.Simple.FromField

7Module: Database.PostgreSQL.Simple.FromField

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

107 , PQ.Oid(..)

106 , PQ.Oid(..)

108 , PQ.Format(..)

107 , PQ.Format(..)

109 , pgArrayFieldParser

108 , pgArrayFieldParser

110− , attoFieldParser

111

109

112− , optionalField

113 , fromJSONField

110 , fromJSONField

114− , fromFieldJSONByteString

115 ) where

111 ) where

116

112

117#include "MachDeps.h"

113#include "MachDeps.h"

118

114

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

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

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

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

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

117+import Control.Exception (Exception)

122import qualified Data.Aeson as JSON

118import qualified Data.Aeson as JSON

119+import qualified Data.Aeson.Parser as JSON (value')

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

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

124import Data.ByteString (ByteString)

121import Data.ByteString (ByteString)

125import qualified Data.ByteString.Char8 as B

122import qualified Data.ByteString.Char8 as B

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

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

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

128import Data.IORef (IORef, newIORef)

124import Data.IORef (IORef, newIORef)

129import Data.Ratio (Ratio)

125import Data.Ratio (Ratio)

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

126+import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )

131import Data.Typeable (Typeable, typeOf)

127import Data.Typeable (Typeable, typeOf)

132import Data.Vector (Vector)

128import Data.Vector (Vector)

133import Data.Vector.Mutable (IOVector)

129import Data.Vector.Mutable (IOVector)

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

138import Database.PostgreSQL.Simple.Types

134import Database.PostgreSQL.Simple.Types

139import Database.PostgreSQL.Simple.TypeInfo as TI

135import Database.PostgreSQL.Simple.TypeInfo as TI

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

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

137+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI

141import Database.PostgreSQL.Simple.Time

138import Database.PostgreSQL.Simple.Time

142import Database.PostgreSQL.Simple.Arrays as Arrays

139import Database.PostgreSQL.Simple.Arrays as Arrays

143import qualified Database.PostgreSQL.LibPQ as PQ

140import qualified Database.PostgreSQL.LibPQ as PQ

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

154import Data.Scientific (Scientific)

151import Data.Scientific (Scientific)

155import GHC.Real (infinity, notANumber)

152import GHC.Real (infinity, notANumber)

156

153

157−import qualified Data.Aeson.Types as JSON

158−

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

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

160-- value fails.

155-- value fails.

161data ResultError = Incompatible { errSQLType :: String

156data ResultError = Incompatible { errSQLType :: String

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

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

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

183 deriving (Eq, Show, Typeable)

178 deriving (Eq, Show, Typeable)

184

179

185−instance Exception ResultError where

180+instance Exception ResultError

186− toException = postgresqlExceptionToException

187− fromException = postgresqlExceptionFromException

188

181

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

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

190left = conversionError

183left = conversionError

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

250 then Nothing

243 then Nothing

251 else Just x

244 else Just x

252

245

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

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

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

247+-- off the associated table column. Numbering starts from 0. Analogous

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

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

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

248+-- to libpq's @PQftablecol@.

258

249

259tableColumn :: Field -> Int

250tableColumn :: Field -> Int

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

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

@@ -270,33 +261,16 @@ format Field{..} = unsafeDupablePerformIO (PQ.fformat result column)

270-- | void

261-- | void

271instance FromField () where

262instance FromField () where

272 fromField f _bs

263 fromField f _bs

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

264+ | typeOid f /= $(inlineTypoid TI.void) = returnError Incompatible f ""

274 | otherwise = pure ()

265 | otherwise = pure ()

275

266

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−

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

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

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

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

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

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

285-- behavior.

270-- behavior.

286−instance FromField a => FromField (Maybe a) where

271+instance (FromField a) => FromField (Maybe a) where

287− fromField = optionalField fromField

288−

289−-- | For dealing with SQL @null@ values outside of the 'FromField' class.

290−-- Alternatively, one could use 'Control.Applicative.optional', but that

291−-- also turns type and conversion errors into 'Nothing', whereas this is

292−-- more specific and turns only @null@ values into 'Nothing'.

293−

294−optionalField :: FieldParser a -> FieldParser (Maybe a)

295−optionalField p f mv =

296− case mv of

297− Nothing -> pure Nothing

272+ fromField _ Nothing = pure Nothing

298− Just _ -> Just <$> p f mv

273+ fromField f bs = Just <$> fromField f bs

299−{-# INLINE optionalField #-}

300

274

301-- | compatible with any data type, but the value must be null

275-- | compatible with any data type, but the value must be null

302instance FromField Null where

276instance FromField Null where

@@ -306,30 +280,30 @@ instance FromField Null where

306-- | bool

280-- | bool

307instance FromField Bool where

281instance FromField Bool where

308 fromField f bs

282 fromField f bs

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

283+ | typeOid f /= $(inlineTypoid TI.bool) = returnError Incompatible f ""

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

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

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

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

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

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

313 | otherwise = returnError ConversionFailed f ""

287 | otherwise = returnError ConversionFailed f ""

314

288

315−-- | \"char\", bpchar

289+-- | \"char\"

316instance FromField Char where

290instance FromField Char where

317− fromField f bs0 =

291+ fromField f bs =

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

292+ if typeOid f /= $(inlineTypoid TI.char)

293+ then returnError Incompatible f ""

319− then case bs0 of

294+ else case bs of

320 Nothing -> returnError UnexpectedNull f ""

295 Nothing -> returnError UnexpectedNull f ""

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

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

322 then returnError ConversionFailed f "length not 1"

297 then returnError ConversionFailed f "length not 1"

323 else return $! (B.head bs)

298 else return $! (B.head bs)

324− else returnError Incompatible f ""

325

299

326-- | int2

300-- | int2

327instance FromField Int16 where

301instance FromField Int16 where

328− fromField = attoFieldParser ok16 $ signed decimal

302+ fromField = atto ok16 $ signed decimal

329

303

330-- | int2, int4

304-- | int2, int4

331instance FromField Int32 where

305instance FromField Int32 where

332− fromField = attoFieldParser ok32 $ signed decimal

306+ fromField = atto ok32 $ signed decimal

333

307

334#if WORD_SIZE_IN_BITS < 64

308#if WORD_SIZE_IN_BITS < 64

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

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

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

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

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

340#endif

314#endif

341instance FromField Int where

315instance FromField Int where

342− fromField = attoFieldParser okInt $ signed decimal

316+ fromField = atto okInt $ signed decimal

343

317

344-- | int2, int4, int8

318-- | int2, int4, int8

345instance FromField Int64 where

319instance FromField Int64 where

346− fromField = attoFieldParser ok64 $ signed decimal

320+ fromField = atto ok64 $ signed decimal

347

321

348-- | int2, int4, int8

322-- | int2, int4, int8

349instance FromField Integer where

323instance FromField Integer where

350− fromField = attoFieldParser ok64 $ signed decimal

324+ fromField = atto ok64 $ signed decimal

351

325

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

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

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

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

354instance FromField Float where

328instance FromField Float where

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

329+ fromField = atto ok (realToFrac <$> pg_double)

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

330+ where ok = $(mkCompats [TI.float4,TI.int2])

357

331

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

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

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

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

360instance FromField Double where

334instance FromField Double where

361− fromField = attoFieldParser ok pg_double

335+ fromField = atto ok pg_double

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

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

363

337

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

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

365instance FromField (Ratio Integer) where

339instance FromField (Ratio Integer) where

366− fromField = attoFieldParser ok pg_rational

340+ fromField = atto ok pg_rational

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

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

368

342

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

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

370instance FromField Scientific where

344instance FromField Scientific where

371− fromField = attoFieldParser ok rational

345+ fromField = atto ok rational

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

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

373

347

374unBinary :: Binary t -> t

348unBinary :: Binary t -> t

375unBinary (Binary x) = x

349unBinary (Binary x) = x

@@ -390,13 +364,13 @@ pg_rational

390

364

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

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

392instance FromField SB.ByteString where

366instance FromField SB.ByteString where

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

367+ fromField f dat = if typeOid f == $(inlineTypoid TI.bytea)

394 then unBinary <$> fromField f dat

368 then unBinary <$> fromField f dat

395 else doFromField f okText' pure dat

369 else doFromField f okText' pure dat

396

370

397-- | oid

371-- | oid

398instance FromField PQ.Oid where

372instance FromField PQ.Oid where

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

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

400

374

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

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

402instance FromField LB.ByteString where

376instance FromField LB.ByteString where

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

404

378

405unescapeBytea :: Field -> SB.ByteString

379unescapeBytea :: Field -> SB.ByteString

406 -> Conversion (Binary SB.ByteString)

380 -> Conversion (Binary SB.ByteString)

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

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

408 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

382 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

409 Just str -> pure (Binary str)

383 Just str -> pure (Binary str)

410

384

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

455

429

456-- | timestamptz

430-- | timestamptz

457instance FromField UTCTime where

431instance FromField UTCTime where

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

432+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTime" parseUTCTime

459

433

460-- | timestamptz

434-- | timestamptz

461instance FromField ZonedTime where

435instance FromField ZonedTime where

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

436+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTime" parseZonedTime

463

437

464-- | timestamp

438-- | timestamp

465instance FromField LocalTime where

439instance FromField LocalTime where

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

440+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTime" parseLocalTime

467

441

468-- | date

442-- | date

469instance FromField Day where

443instance FromField Day where

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

444+ fromField = ff $(inlineTypoid TI.date) "Day" parseDay

471

445

472-- | time

446-- | time

473instance FromField TimeOfDay where

447instance FromField TimeOfDay where

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

448+ fromField = ff $(inlineTypoid TI.time) "TimeOfDay" parseTimeOfDay

475

449

476-- | timestamptz

450-- | timestamptz

477instance FromField UTCTimestamp where

451instance FromField UTCTimestamp where

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

452+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTimestamp" parseUTCTimestamp

479

453

480-- | timestamptz

454-- | timestamptz

481instance FromField ZonedTimestamp where

455instance FromField ZonedTimestamp where

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

456+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTimestamp" parseZonedTimestamp

483

457

484-- | timestamp

458-- | timestamp

485instance FromField LocalTimestamp where

459instance FromField LocalTimestamp where

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

460+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTimestamp" parseLocalTimestamp

487

461

488-- | date

462-- | date

489instance FromField Date where

463instance FromField Date where

490− fromField = ff TI.dateOid "Date" parseDate

464+ fromField = ff $(inlineTypoid TI.date) "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

500

465

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

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

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

467 -> Field -> Maybe B8.ByteString -> Conversion a

503−ff compatOid hsType parseBS f mstr =

468+ff compatOid hsType parse f mstr =

504 if typeOid f /= compatOid

469 if typeOid f /= compatOid

505 then err Incompatible ""

470 then err Incompatible ""

506 else case mstr of

471 else case mstr of

507 Nothing -> err UnexpectedNull ""

472 Nothing -> err UnexpectedNull ""

508− Just str -> case parseBS str of

473+ Just str -> case parse str of

509 Left msg -> err ConversionFailed msg

474 Left msg -> err ConversionFailed msg

510 Right val -> return val

475 Right val -> return val

511 where

476 where

@@ -543,13 +508,13 @@ pgArrayFieldParser fieldParser f mdat = do

543 _ -> returnError Incompatible f ""

508 _ -> returnError Incompatible f ""

544

509

545fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])

510fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])

546−fromArray fieldParser typInfo f = sequence . (parseIt <$>) <$> array delim

511+fromArray fieldParser typeInfo f = sequence . (parseIt <$>) <$> array delim

547 where

512 where

548− delim = typdelim (typelem typInfo)

513+ delim = typdelim (typelem typeInfo)

549− fElem = f{ typeOid = typoid (typelem typInfo) }

514+ fElem = f{ typeOid = typoid (typelem typeInfo) }

550

515

551 parseIt item =

516 parseIt item =

552− fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item'

517+ fieldParser f' $ if item' == "NULL" then Nothing else Just item'

553 where

518 where

554 item' = fmt delim item

519 item' = fmt delim item

555 f' | Arrays.Array _ <- item = f

520 f' | Arrays.Array _ <- item = f

@@ -564,7 +529,7 @@ instance (FromField a, Typeable a) => FromField (IOVector a) where

564-- | uuid

529-- | uuid

565instance FromField UUID where

530instance FromField UUID where

566 fromField f mbs =

531 fromField f mbs =

567− if typeOid f /= TI.uuidOid

532+ if typeOid f /= $(inlineTypoid TI.uuid)

568 then returnError Incompatible f ""

533 then returnError Incompatible f ""

569 else case mbs of

534 else case mbs of

570 Nothing -> returnError UnexpectedNull f ""

535 Nothing -> returnError UnexpectedNull f ""

@@ -573,26 +538,20 @@ instance FromField UUID where

573 Nothing -> returnError ConversionFailed f "Invalid UUID"

538 Nothing -> returnError ConversionFailed f "Invalid UUID"

574 Just uuid -> pure uuid

539 Just uuid -> pure uuid

575

540

576−-- | json, jsonb

541+-- | json

577instance FromField JSON.Value where

542instance FromField JSON.Value where

578− fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs

543+ fromField f mbs =

579− where parseBS bs = case JSON.eitherDecodeStrict' bs of

580− Left err -> returnError ConversionFailed f err

581− Right val -> pure val

582−

583−-- | Return the JSON ByteString directly

584−--

585−-- @since 0.6.3

586−fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString

587−fromFieldJSONByteString f mbs =

588− if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid

544+ if typeOid f /= $(inlineTypoid TI.json) && typeOid f /= $(inlineTypoid TI.jsonb)

589 then returnError Incompatible f ""

545 then returnError Incompatible f ""

590 else case mbs of

546 else case mbs of

591 Nothing -> returnError UnexpectedNull f ""

547 Nothing -> returnError UnexpectedNull f ""

592− Just bs -> pure bs

548+ Just bs ->

549+ case parseOnly (JSON.value' <* endOfInput) bs of

550+ Left err -> returnError ConversionFailed f err

551+ Right val -> pure val

593

552

594-- | Parse a field to a JSON 'JSON.Value' and convert that into a

553-- | Parse a field to a JSON 'JSON.Value' and convert that into a

595−-- Haskell value using the 'JSON.FromJSON' instance.

554+-- Haskell value using 'JSON.fromJSON'.

596--

555--

597-- This can be used as the default implementation for the 'fromField'

556-- This can be used as the default implementation for the 'fromField'

598-- method for Haskell types that have a JSON representation in

557-- method for Haskell types that have a JSON representation in

@@ -600,23 +559,14 @@ fromFieldJSONByteString f mbs =

600--

559--

601-- The 'Typeable' constraint is required to show more informative

560-- The 'Typeable' constraint is required to show more informative

602-- error messages when parsing fails.

561-- 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@

613fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a

562fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a

614fromJSONField f mbBs = do

563fromJSONField f mbBs = do

615 value <- fromField f mbBs

564 value <- fromField f mbBs

616− case JSON.ifromJSON value of

565+ case JSON.fromJSON value of

617− JSON.IError path err -> returnError ConversionFailed f $

566+ JSON.Error err -> returnError ConversionFailed f $

618− "JSON decoding error: " ++ (JSON.formatError path err)

567+ "JSON decoding error: " ++ err

619− JSON.ISuccess x -> pure x

568+ JSON.Success x -> pure x

569+

620

570

621-- | Compatible with the same set of types as @a@. Note that

571-- | Compatible with the same set of types as @a@. Note that

622-- modifying the 'IORef' does not have any effects outside

572-- modifying the 'IORef' does not have any effects outside

@@ -633,33 +583,20 @@ instance FromField a => FromField (MVar a) where

633type Compat = PQ.Oid -> Bool

583type Compat = PQ.Oid -> Bool

634

584

635okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat

585okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat

636−okText = eq TI.nameOid \/ eq TI.textOid \/ eq TI.charOid

586+okText = $( mkCompats [ TI.name, TI.text, TI.char,

637− \/ eq TI.bpcharOid \/ eq TI.varcharOid

587+ TI.bpchar, TI.varchar ] )

638−okText' = eq TI.nameOid \/ eq TI.textOid \/ eq TI.charOid

588+okText' = $( mkCompats [ TI.name, TI.text, TI.char,

639− \/ eq TI.bpcharOid \/ eq TI.varcharOid \/ eq TI.unknownOid

589+ TI.bpchar, TI.varchar, TI.unknown ] )

640−okBinary = eq TI.byteaOid

590+okBinary = (== $( inlineTypoid TI.bytea ))

641−ok16 = eq TI.int2Oid

591+ok16 = (== $( inlineTypoid TI.int2 ))

642−ok32 = eq TI.int2Oid \/ eq TI.int4Oid

592+ok32 = $( mkCompats [TI.int2,TI.int4] )

643−ok64 = eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid

593+ok64 = $( mkCompats [TI.int2,TI.int4,TI.int8] )

644#if WORD_SIZE_IN_BITS < 64

594#if WORD_SIZE_IN_BITS < 64

645okInt = ok32

595okInt = ok32

646#else

596#else

647okInt = ok64

597okInt = ok64

648#endif

598#endif

649

599

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−

663doFromField :: forall a . (Typeable a)

600doFromField :: forall a . (Typeable a)

664 => Field -> Compat -> (ByteString -> Conversion a)

601 => Field -> Compat -> (ByteString -> Conversion a)

665 -> Maybe ByteString -> Conversion a

602 -> Maybe ByteString -> Conversion a

@@ -684,22 +621,10 @@ returnError mkErr f msg = do

684 (show (typeOf (undefined :: a)))

621 (show (typeOf (undefined :: a)))

685 msg

622 msg

686

623

687−-- | Construct a field parser from an attoparsec parser. An 'Incompatible' error is thrown if the

688−-- PostgreSQL oid does not match the specified predicate.

689−--

690−-- @

691−-- instance FromField Int16 where

692−-- fromField = attoFieldParser ok16 (signed decimal)

693−-- @

694−--

695−-- @since 0.6.3

696−attoFieldParser :: forall a. (Typeable a)

624+atto :: forall a. (Typeable a)

697− => (PQ.Oid -> Bool)

625+ => Compat -> Parser a -> Field -> Maybe ByteString

698− -- ^ Predicate for whether the postgresql type oid is compatible with this parser

626+ -> Conversion a

699− -> Parser a

700− -- ^ An attoparsec parser.

701− -> FieldParser a

702−attoFieldParser types p0 f dat = doFromField f types (go p0) dat

627+atto types p0 f dat = doFromField f types (go p0) dat

703 where

628 where

704 go :: Parser a -> ByteString -> Conversion a

629 go :: Parser a -> ByteString -> Conversion a

705 go p s =

630 go p s =

src/Database/PostgreSQL/Simple/FromRow.hs+6−239

@@ -1,6 +1,4 @@

1−{-# LANGUAGE FlexibleContexts #-}

2−{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}

1+{-# LANGUAGE RecordWildCards, FlexibleInstances #-}

3−

5------------------------------------------------------------------------------

3------------------------------------------------------------------------------

6-- |

4-- |

@@ -29,7 +27,7 @@ module Database.PostgreSQL.Simple.FromRow

29 ) where

27 ) where

31import Prelude hiding (null)

29import Prelude hiding (null)

32−import Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)

30+import Control.Applicative (Applicative(..), (<$>), (<|>), (*>))

33import Control.Monad (replicateM, replicateM_)

31import Control.Monad (replicateM, replicateM_)

34import Control.Monad.Trans.State.Strict

32import Control.Monad.Trans.State.Strict

35import Control.Monad.Trans.Reader

33import Control.Monad.Trans.Reader

@@ -47,17 +45,13 @@ import Database.PostgreSQL.Simple.Ok

47import Database.PostgreSQL.Simple.Types ((:.)(..), Null)

45import Database.PostgreSQL.Simple.Types ((:.)(..), Null)

48import Database.PostgreSQL.Simple.TypeInfo

46import Database.PostgreSQL.Simple.TypeInfo

50−import GHC.Generics

51−

52−

53-- | A collection type that can be converted from a sequence of fields.

48-- | A collection type that can be converted from a sequence of fields.

54-- Instances are provided for tuples up to 10 elements and lists of any length.

49-- Instances are provided for tuples up to 10 elements and lists of any length.

55--

50--

56-- Note that instances can be defined outside of postgresql-simple, which is

51-- Note that instances can be defined outside of postgresql-simple, which is

57-- often useful. For example, here's an instance for a user-defined pair:

52-- often useful. For example, here's an instance for a user-defined pair:

58--

53--

59−-- @

60−-- data User = User { name :: String, fileQuota :: Int }

54+-- @data User = User { name :: String, fileQuota :: Int }

61--

55--

62-- instance 'FromRow' User where

56-- instance 'FromRow' User where

63-- fromRow = User \<$\> 'field' \<*\> 'field'

57-- fromRow = User \<$\> 'field' \<*\> 'field'

@@ -67,32 +61,13 @@ import GHC.Generics

67-- in a single row of the query result. Otherwise, a 'ConversionFailed'

61-- in a single row of the query result. Otherwise, a 'ConversionFailed'

68-- exception will be thrown.

62-- exception will be thrown.

69--

63--

70−-- You can also derive 'FromRow' for your data type using GHC generics, like

71−-- this:

72−--

73−-- @

74−-- \{-# LANGUAGE DeriveAnyClass \#-}

75−-- \{-# LANGUAGE DeriveGeneric \#-}

76−--

77−-- import "GHC.Generics" ('GHC.Generics.Generic')

78−-- import "Database.PostgreSQL.Simple" ('FromRow')

79−--

80−-- data User = User { name :: String, fileQuota :: Int }

81−-- deriving ('GHC.Generics.Generic', 'FromRow')

82−-- @

83−--

84−-- Note that this only works for product types (e.g. records) and does not

85−-- support sum types or recursive types.

86−--

87−-- Note that 'field' evaluates its result to WHNF, so the caveats listed in

64+-- Note that 'field' evaluates it's result to WHNF, so the caveats listed in

88-- mysql-simple and very early versions of postgresql-simple no longer apply.

65-- mysql-simple and very early versions of postgresql-simple no longer apply.

89-- Instead, look at the caveats associated with user-defined implementations

66-- Instead, look at the caveats associated with user-defined implementations

90-- of 'fromField'.

67-- of 'fromField'.

92class FromRow a where

69class FromRow a where

93 fromRow :: RowParser a

70 fromRow :: RowParser a

94− default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a

95− fromRow = to <$> gfromRow

97getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString

72getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString

98getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)

73getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)

@@ -131,8 +106,8 @@ fieldWith fieldP = RP $ do

131 else do

106 else do

132 let !result = rowresult

107 let !result = rowresult

133 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)

108 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)

134− !field' = Field{..}

109+ !field = Field{..}

135− lift (lift (fieldP field' (getvalue result row column)))

110+ lift (lift (fieldP field (getvalue result row column)))

136

111

137field :: FromField a => RowParser a

112field :: FromField a => RowParser a

138field = fieldWith fromField

113field = fieldWith fromField

@@ -255,196 +230,6 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,

255 null *> null *> null *> null *> null *> pure Nothing)

230 null *> null *> null *> null *> null *> pure Nothing)

256 <|> (Just <$> fromRow)

231 <|> (Just <$> fromRow)

257

232

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−

448instance FromField a => FromRow [a] where

233instance FromField a => FromRow [a] where

449 fromRow = do

234 fromRow = do

450 n <- numFieldsRemaining

235 n <- numFieldsRemaining

@@ -467,21 +252,3 @@ instance FromField a => FromRow (Maybe (Vector a)) where

467

252

468instance (FromRow a, FromRow b) => FromRow (a :. b) where

253instance (FromRow a, FromRow b) => FromRow (a :. b) where

469 fromRow = (:.) <$> fromRow <*> fromRow

254 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 <https://www.postgresql.org/docs/9.5/static/hstore.html> for more

11+-- See <http://www.postgresql.org/docs/9.2/static/hstore.html> for more

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−-- <https://www.postgresql.org/docs/9.5/static/contrib.html> for more

18+-- <http://www.postgresql.org/docs/9.2/static/contrib.html> for more

19-- information.

20--

21------------------------------------------------------------------------------

src/Database/PostgreSQL/Simple/HStore/Implementation.hs+11−11

@@ -22,6 +22,9 @@ 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

25import Data.Map(Map)

28import Data.Map(Map)

26import qualified Data.Map as Map

29import qualified Data.Map as Map

27import Data.Text(Text)

30import Data.Text(Text)

@@ -31,7 +34,6 @@ import Data.Text.Encoding.Error(UnicodeException)

31import qualified Data.Text.Lazy as TL

34import qualified Data.Text.Lazy as TL

32import Data.Typeable

35import Data.Typeable

33import Data.Monoid(Monoid(..))

36import Data.Monoid(Monoid(..))

34−import Data.Semigroup

35import Database.PostgreSQL.Simple.FromField

37import Database.PostgreSQL.Simple.FromField

36import Database.PostgreSQL.Simple.ToField

38import Database.PostgreSQL.Simple.ToField

@@ -50,28 +52,26 @@ instance ToHStore HStoreBuilder where

50toBuilder :: HStoreBuilder -> Builder

52toBuilder :: HStoreBuilder -> Builder

51toBuilder x = case x of

53toBuilder x = case x of

52 Empty -> mempty

54 Empty -> mempty

53− Comma c -> c

55+ Comma x -> x

55toLazyByteString :: HStoreBuilder -> BL.ByteString

57toLazyByteString :: HStoreBuilder -> BL.ByteString

56toLazyByteString x = case x of

58toLazyByteString x = case x of

57 Empty -> BL.empty

59 Empty -> BL.empty

58− Comma c -> BU.toLazyByteString c

60+ Comma x -> BU.toLazyByteString x

60−instance Semigroup HStoreBuilder where

62+instance Monoid HStoreBuilder where

61− Empty <> x = x

63+ mempty = Empty

64+ mappend Empty x = x

62− Comma a <> x

65+ mappend (Comma a) x

63 = Comma (a `mappend` case x of

66 = Comma (a `mappend` case x of

64 Empty -> mempty

67 Empty -> mempty

65 Comma b -> char8 ',' `mappend` b)

68 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, Semigroup, Monoid)

74+newtype HStoreText = HStoreText Builder deriving (Typeable, 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,3 +1,5 @@

1+{-# OPTIONS_HADDOCK hide #-}

1------------------------------------------------------------------------------

3------------------------------------------------------------------------------

2-- |

4-- |

3-- Module: Database.PostgreSQL.Simple.HStore.Internal

5-- Module: Database.PostgreSQL.Simple.HStore.Internal

src/Database/PostgreSQL/Simple/Internal.hs+25−84

@@ -1,13 +1,10 @@

1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}

2−{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE ExistentialQuantification #-}

5−{-# LANGUAGE InstanceSigs #-}

7------------------------------------------------------------------------------

4------------------------------------------------------------------------------

8-- |

5-- |

9-- Module: Database.PostgreSQL.Simple.Internal

6-- Module: Database.PostgreSQL.Simple.Internal

11-- License: BSD3

8-- License: BSD3

12-- Maintainer: Leon P Smith <leon@melding-monads.com>

9-- Maintainer: Leon P Smith <leon@melding-monads.com>

13-- Stability: experimental

10-- Stability: experimental

@@ -36,6 +33,7 @@ import Data.Int (Int64)

36import qualified Data.IntMap as IntMap

33import qualified Data.IntMap as IntMap

37import Data.IORef

34import Data.IORef

38import Data.Maybe(fromMaybe)

35import Data.Maybe(fromMaybe)

36+import Data.Monoid

39import Data.String

37import Data.String

40import qualified Data.Text as T

38import qualified Data.Text as T

41import qualified Data.Text.Encoding as TE

39import qualified Data.Text.Encoding as TE

@@ -52,7 +50,6 @@ import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)

52import Control.Monad.Trans.State.Strict

50import Control.Monad.Trans.State.Strict

53import Control.Monad.Trans.Reader

51import Control.Monad.Trans.Reader

54import Control.Monad.Trans.Class

52import Control.Monad.Trans.Class

55−import GHC.Generics

56import GHC.IO.Exception

53import GHC.IO.Exception

57#if !defined(mingw32_HOST_OS)

54#if !defined(mingw32_HOST_OS)

58import Control.Concurrent(threadWaitRead, threadWaitWrite)

55import Control.Concurrent(threadWaitRead, threadWaitWrite)

@@ -83,40 +80,18 @@ data Connection = Connection {

83instance Eq Connection where

80instance Eq Connection where

84 x == y = connectionHandle x == connectionHandle y

81 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−

105data SqlError = SqlError {

83data SqlError = SqlError {

106 sqlState :: ByteString

84 sqlState :: ByteString

107 , sqlExecStatus :: ExecStatus

85 , sqlExecStatus :: ExecStatus

108 , sqlErrorMsg :: ByteString

86 , sqlErrorMsg :: ByteString

109 , sqlErrorDetail :: ByteString

87 , sqlErrorDetail :: ByteString

110 , sqlErrorHint :: ByteString

88 , sqlErrorHint :: ByteString

111− } deriving (Eq, Show, Typeable)

89+ } deriving (Show, Typeable)

112

113fatalError :: ByteString -> SqlError

91fatalError :: ByteString -> SqlError

114fatalError msg = SqlError "" FatalError msg "" ""

92fatalError msg = SqlError "" FatalError msg "" ""

115

116−instance Exception SqlError where

94+instance Exception SqlError

117− toException = postgresqlExceptionToException

118− fromException = postgresqlExceptionFromException

119−

120

121-- | Exception thrown if 'query' is used to perform an @INSERT@-like

96-- | Exception thrown if 'query' is used to perform an @INSERT@-like

122-- operation, or 'execute' is used to perform a @SELECT@-like operation.

97-- operation, or 'execute' is used to perform a @SELECT@-like operation.

@@ -125,9 +100,7 @@ data QueryError = QueryError {

125 , qeQuery :: Query

100 , qeQuery :: Query

126 } deriving (Eq, Show, Typeable)

101 } deriving (Eq, Show, Typeable)

127

102

128−instance Exception QueryError where

103+instance Exception QueryError

129− toException = postgresqlExceptionToException

130− fromException = postgresqlExceptionFromException

131

104

132-- | Exception thrown if a 'Query' could not be formatted correctly.

105-- | Exception thrown if a 'Query' could not be formatted correctly.

133-- This may occur if the number of \'@?@\' characters in the query

106-- This may occur if the number of \'@?@\' characters in the query

@@ -138,9 +111,7 @@ data FormatError = FormatError {

138 , fmtParams :: [ByteString]

111 , fmtParams :: [ByteString]

139 } deriving (Eq, Show, Typeable)

112 } deriving (Eq, Show, Typeable)

140

113

141−instance Exception FormatError where

114+instance Exception FormatError

142− toException = postgresqlExceptionToException

143− fromException = postgresqlExceptionFromException

144

115

145data ConnectInfo = ConnectInfo {

116data ConnectInfo = ConnectInfo {

146 connectHost :: String

117 connectHost :: String

@@ -148,7 +119,7 @@ data ConnectInfo = ConnectInfo {

148 , connectUser :: String

119 , connectUser :: String

149 , connectPassword :: String

120 , connectPassword :: String

150 , connectDatabase :: String

121 , connectDatabase :: String

151− } deriving (Generic,Eq,Read,Show,Typeable)

122+ } deriving (Eq,Read,Show,Typeable)

152

123

153-- | Default information for setting up a connection.

124-- | Default information for setting up a connection.

154--

125--

@@ -182,20 +153,10 @@ defaultConnectInfo = ConnectInfo {

182connect :: ConnectInfo -> IO Connection

153connect :: ConnectInfo -> IO Connection

183connect = connectPostgreSQL . postgreSQLConnectionString

154connect = connectPostgreSQL . postgreSQLConnectionString

184

155

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−

191-- | Attempt to make a connection based on a libpq connection string.

156-- | Attempt to make a connection based on a libpq connection string.

192−-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>

157+-- See <http://www.postgresql.org/docs/9.3/static/libpq-connect.html#LIBPQ-CONNSTRING>

193−-- for more information. Also note that environment variables also affect

158+-- for more information. Here is an example with some

194−-- parameters not provided, parameters provided as the empty string, and a

195−-- few other things; see

196−-- <https://www.postgresql.org/docs/9.5/static/libpq-envars.html>

197−-- for details. Here is an example with some of the most commonly used

159+-- of the most commonly used parameters:

198−-- parameters:

199--

160--

200-- > host='db.somedomain.com' port=5432 ...

161-- > host='db.somedomain.com' port=5432 ...

201--

162--

@@ -223,9 +184,8 @@ withConnect connInfo = bracket (connect connInfo) close

223--

184--

224-- Omitting @password@ will default to an appropriate password found

185-- Omitting @password@ will default to an appropriate password found

225-- in the @pgpass@ file, or no password at all if a matching line is

186-- in the @pgpass@ file, or no password at all if a matching line is

226−-- not found. The path of the @pgpass@ file may be specified by setting

187+-- not found. See

227−-- the @PGPASSFILE@ environment variable. See

228−-- <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for

188+-- <http://www.postgresql.org/docs/9.3/static/libpq-pgpass.html> for

229-- more information regarding this file.

189-- more information regarding this file.

230--

190--

231-- As all parameters are optional and the defaults are sensible, the

191-- As all parameters are optional and the defaults are sensible, the

@@ -243,20 +203,18 @@ withConnect connInfo = bracket (connect connInfo) close

243-- or production machines, or you will need to use a @pgpass@ file

203-- or production machines, or you will need to use a @pgpass@ file

244-- with the @password@ or @md5@ authentication methods.

204-- with the @password@ or @md5@ authentication methods.

245--

205--

246−-- See <https://www.postgresql.org/docs/9.5/static/client-authentication.html>

206+-- See <http://www.postgresql.org/docs/9.3/static/client-authentication.html>

247-- for more information regarding the authentication process.

207-- for more information regarding the authentication process.

248--

208--

249-- SSL/TLS will typically "just work" if your postgresql server supports or

209-- SSL/TLS will typically "just work" if your postgresql server supports or

250-- requires it. However, note that libpq is trivially vulnerable to a MITM

210-- requires it. However, note that libpq is trivially vulnerable to a MITM

251−-- attack without setting additional SSL connection parameters. In

211+-- attack without setting additional SSL parameters in the connection string.

252−-- particular, @sslmode@ needs to be set to @require@, @verify-ca@, or

212+-- In particular, @sslmode@ needs to be set to @require@, @verify-ca@, or

253-- @verify-full@ in order to perform certificate validation. When @sslmode@

213-- @verify-full@ in order to perform certificate validation. When @sslmode@

254-- is @require@, then you will also need to specify a @sslrootcert@ file,

214-- is @require@, then you will also need to specify a @sslrootcert@ file,

255-- otherwise no validation of the server's identity will be performed.

215-- otherwise no validation of the server's identity will be performed.

256-- Client authentication via certificates is also possible via the

216-- Client authentication via certificates is also possible via the

257−-- @sslcert@ and @sslkey@ parameters. See

217+-- @sslcert@ and @sslkey@ parameters.

258−-- <https://www.postgresql.org/docs/9.5/static/libpq-ssl.html>

259−-- for detailed information regarding libpq and SSL.

260

218

261connectPostgreSQL :: ByteString -> IO Connection

219connectPostgreSQL :: ByteString -> IO Connection

262connectPostgreSQL connstr = do

220connectPostgreSQL connstr = do

@@ -323,7 +281,7 @@ postgreSQLConnectionString connectInfo = fromString connstr

323

281

324 str name field

282 str name field

325 | null value = id

283 | null value = id

326− | otherwise = showString name . addQuotes value . space

284+ | otherwise = showString name . quote value . space

327 where value = field connectInfo

285 where value = field connectInfo

328

286

329 num name field

287 num name field

@@ -331,7 +289,7 @@ postgreSQLConnectionString connectInfo = fromString connstr

331 | otherwise = showString name . shows value . space

289 | otherwise = showString name . shows value . space

332 where value = field connectInfo

290 where value = field connectInfo

333

291

334− addQuotes s rest = '\'' : foldr delta ('\'' : rest) s

292+ quote str rest = '\'' : foldr delta ('\'' : rest) str

335 where

293 where

336 delta c cs = case c of

294 delta c cs = case c of

337 '\\' -> '\\' : '\\' : cs

295 '\\' -> '\\' : '\\' : cs

@@ -387,7 +345,6 @@ exec conn sql =

387 Just res -> do

345 Just res -> do

388 status <- PQ.resultStatus res

346 status <- PQ.resultStatus res

389 case status of

347 case status of

390− -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple

391 PQ.EmptyQuery -> getResult h mres'

348 PQ.EmptyQuery -> getResult h mres'

392 PQ.CommandOk -> getResult h mres'

349 PQ.CommandOk -> getResult h mres'

393 PQ.TuplesOk -> getResult h mres'

350 PQ.TuplesOk -> getResult h mres'

@@ -408,7 +365,6 @@ finishExecute :: Connection -> Query -> PQ.Result -> IO Int64

408finishExecute _conn q result = do

365finishExecute _conn q result = do

409 status <- PQ.resultStatus result

366 status <- PQ.resultStatus result

410 case status of

367 case status of

411− -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple

412 PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q

368 PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q

413 PQ.CommandOk -> do

369 PQ.CommandOk -> do

414 ncols <- PQ.nfields result

370 ncols <- PQ.nfields result

@@ -419,7 +375,7 @@ finishExecute _conn q result = do

419 nstr <- PQ.cmdTuples result

375 nstr <- PQ.cmdTuples result

420 return $ case nstr of

376 return $ case nstr of

421 Nothing -> 0 -- is this appropriate?

377 Nothing -> 0 -- is this appropriate?

422− Just str -> mkInteger str

378+ Just str -> toInteger str

423 PQ.TuplesOk -> do

379 PQ.TuplesOk -> do

424 ncols <- PQ.nfields result

380 ncols <- PQ.nfields result

425 throwIO $ QueryError ("execute resulted in " ++ show ncols ++

381 throwIO $ QueryError ("execute resulted in " ++ show ncols ++

@@ -432,7 +388,7 @@ finishExecute _conn q result = do

432 PQ.NonfatalError -> throwResultError "execute" result status

388 PQ.NonfatalError -> throwResultError "execute" result status

433 PQ.FatalError -> throwResultError "execute" result status

389 PQ.FatalError -> throwResultError "execute" result status

434 where

390 where

435− mkInteger str = B8.foldl' delta 0 str

391+ toInteger str = B8.foldl' delta 0 str

436 where

392 where

437 delta acc c =

393 delta acc c =

438 if '0' <= c && c <= '9'

394 if '0' <= c && c <= '9'

@@ -447,8 +403,8 @@ throwResultError _ result status = do

447 PQ.resultErrorField result PQ.DiagMessageDetail

403 PQ.resultErrorField result PQ.DiagMessageDetail

448 hint <- fromMaybe "" <$>

404 hint <- fromMaybe "" <$>

449 PQ.resultErrorField result PQ.DiagMessageHint

405 PQ.resultErrorField result PQ.DiagMessageHint

450− state' <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate

406+ state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate

451− throwIO $ SqlError { sqlState = state'

407+ throwIO $ SqlError { sqlState = state

452 , sqlExecStatus = status

408 , sqlExecStatus = status

453 , sqlErrorMsg = errormsg

409 , sqlErrorMsg = errormsg

454 , sqlErrorDetail = detail

410 , sqlErrorDetail = detail

@@ -517,6 +473,7 @@ instance Alternative Conversion where

517 Errors _ -> (oka <|>) <$> runConversion mb conn

473 Errors _ -> (oka <|>) <$> runConversion mb conn

518

474

519instance Monad Conversion where

475instance Monad Conversion where

476+ return a = Conversion $ \_conn -> return (return a)

520 m >>= f = Conversion $ \conn -> do

477 m >>= f = Conversion $ \conn -> do

521 oka <- runConversion m conn

478 oka <- runConversion m conn

522 case oka of

479 case oka of

@@ -531,7 +488,7 @@ conversionMap :: (Ok a -> Ok b) -> Conversion a -> Conversion b

531conversionMap f m = Conversion $ \conn -> f <$> runConversion m conn

488conversionMap f m = Conversion $ \conn -> f <$> runConversion m conn

532

489

533conversionError :: Exception err => err -> Conversion a

490conversionError :: Exception err => err -> Conversion a

534−conversionError err = Conversion $ \_ -> return (Errors [toException err])

491+conversionError err = Conversion $ \_ -> return (Errors [SomeException err])

535

492

536newTempName :: Connection -> IO Query

493newTempName :: Connection -> IO Query

537newTempName Connection{..} = do

494newTempName Connection{..} = do

@@ -619,19 +576,3 @@ escapeIdentifier = escapeWrap PQ.escapeIdentifier

619

576

620escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

577escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

621escapeByteaConn = escapeWrap PQ.escapeByteaConn

578escapeByteaConn = escapeWrap PQ.escapeByteaConn

622−

623−breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)

624−breakOnSingleQuestionMark b = go (B8.empty, b)

625− where go (x,bs) = (x `B8.append` x',bs')

626− -- seperate from first QM

627− where tup@(noQ, restWithQ) = B8.break (=='?') bs

628− -- if end of query, just return

629− -- else check for second QM in 'go2'

630− (x', bs') = maybe tup go2 $

631− -- drop found QM and peek at next char

632− B8.uncons restWithQ >>= B8.uncons . snd

633− -- another QM after the first means:

634− -- take literal QM and keep going.

635− go2 ('?', t2) = go (noQ `B8.snoc` '?',t2)

636− -- Anything else means

637− go2 _ = tup

src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hsdeleted−123

@@ -1,123 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−

3−------------------------------------------------------------------------------

4−-- |

5−-- Module: Database.PostgreSQL.Simple.Internal.PQResultUtils

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−-- <https://www.postgresql.org/docs/9.5/static/largeobjects.html> for more

10+-- <http://www.postgresql.org/docs/9.1/static/largeobjects.html> for more

11-- information.

12--

13-- Note that Large Object File Descriptors are only valid within a single

src/Database/PostgreSQL/Simple/Newtypes.hsdeleted−49

@@ -1,49 +0,0 @@

1−{-# LANGUAGE DeriveFunctor #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

3−-- | Module with newtypes suitable to usage with @DerivingVia@ or standalone.

4−--

5−-- The newtypes are named after packages they wrap.

6−module Database.PostgreSQL.Simple.Newtypes (

7− Aeson (..), getAeson,

8−) where

9−

10−import Data.Typeable (Typeable)

11−import Database.PostgreSQL.Simple.ToField (ToField (..))

12−import Database.PostgreSQL.Simple.FromField (FromField (..), fromJSONField)

13−

14−import qualified Data.Aeson as Aeson

15−

16−-------------------------------------------------------------------------------

17−-- aeson

18−-------------------------------------------------------------------------------

19−

20−-- | A newtype wrapper with 'ToField' and 'FromField' instances

21−-- based on 'Aeson.ToJSON' and 'Aeson.FromJSON' type classes from @aeson@.

22−--

23−-- Example using @DerivingVia@:

24−--

25−-- @

26−-- data Foo = Foo Int String

27−-- deriving stock (Eq, Show, Generic) -- GHC built int

28−-- deriving anyclass ('Aeson.FromJSON', 'Aeson.ToJSON') -- Derived using GHC Generics

29−-- deriving ('ToField', 'FromField') via 'Aeson' Foo -- DerivingVia

30−-- @

31−--

32−-- Example using 'Aeson' newtype directly, for more ad-hoc queries

33−--

34−-- @

35−-- execute conn "INSERT INTO tbl (fld) VALUES (?)" (Only ('Aeson' x))

36−-- @

37−--

38−-- @since 0.6.3

39−newtype Aeson a = Aeson a

40− deriving (Eq, Show, Read, Typeable, Functor)

41−

42−getAeson :: Aeson a -> a

43−getAeson (Aeson a) = a

44−

45−instance Aeson.ToJSON a => ToField (Aeson a) where

46− toField = toField . Aeson.encode . getAeson

47−

48−instance (Aeson.FromJSON a, Typeable a) => FromField (Aeson a) where

49− fromField f bs = fmap Aeson (fromJSONField f bs)

src/Database/PostgreSQL/Simple/Notification.hs+32−62

@@ -5,8 +5,7 @@

5-----------------------------------------------------------------------------

6-- |

7-- Module : Database.PostgreSQL.Simple.Notification

10-- License : BSD3

9-- License : BSD3

11--

10--

12-- Maintainer : leon@melding-monads.com

11-- Maintainer : leon@melding-monads.com

@@ -14,7 +13,7 @@

14--

13--

15-- Support for receiving asynchronous notifications via PostgreSQL's

14-- Support for receiving asynchronous notifications via PostgreSQL's

16-- Listen/Notify mechanism. See

15-- Listen/Notify mechanism. See

17−-- <https://www.postgresql.org/docs/9.5/static/sql-notify.html> for more

16+-- <http://www.postgresql.org/docs/9.1/static/sql-notify.html> for more

18-- information.

17-- information.

19--

18--

20-- Note that on Windows, @getNotification@ currently uses a polling loop

19-- Note that on Windows, @getNotification@ currently uses a polling loop

@@ -25,7 +24,7 @@

25-- Notifications do not create any extra work for the backend, and are

24-- Notifications do not create any extra work for the backend, and are

26-- likely cheaper on the client side as well.

25-- likely cheaper on the client side as well.

27--

26--

28−-- <https://hackage.haskell.org/trac/ghc/ticket/7353>

27+-- <http://hackage.haskell.org/trac/ghc/ticket/7353>

29--

28--

30-----------------------------------------------------------------------------

29-----------------------------------------------------------------------------

@@ -36,27 +35,19 @@ module Database.PostgreSQL.Simple.Notification

36 , getBackendPID

35 , getBackendPID

37 ) where

36 ) where

39−import Control.Monad ( join, void )

38+import Control.Concurrent

39+import Control.Monad ( when )

40−import Control.Exception ( throwIO, catch )

40+import Control.Exception ( throwIO )

41import qualified Data.ByteString as B

42−import qualified Data.ByteString.Char8 as B8

43import Database.PostgreSQL.Simple.Internal

42import Database.PostgreSQL.Simple.Internal

44import qualified Database.PostgreSQL.LibPQ as PQ

43import qualified Database.PostgreSQL.LibPQ as PQ

45import System.Posix.Types ( CPid )

44import 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

55data Notification = Notification

46data Notification = Notification

56− { notificationPid :: {-# UNPACK #-} !CPid

47+ { notificationPid :: !CPid

57− , notificationChannel :: {-# UNPACK #-} !B.ByteString

48+ , notificationChannel :: !B.ByteString

58− , notificationData :: {-# UNPACK #-} !B.ByteString

49+ , notificationData :: !B.ByteString

59− } deriving (Show, Eq)

50+ }

61convertNotice :: PQ.Notify -> Notification

52convertNotice :: PQ.Notify -> Notification

62convertNotice PQ.Notify{..}

53convertNotice PQ.Notify{..}

@@ -66,56 +57,35 @@ convertNotice PQ.Notify{..}

67-- | Returns a single notification. If no notifications are available,

58-- | Returns a single notification. If no notifications are available,

68-- 'getNotification' blocks until one arrives.

59-- '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.

74getNotification :: Connection -> IO Notification

61getNotification :: Connection -> IO Notification

75−getNotification conn = join $ withConnection conn fetch

62+getNotification conn = loop False

76 where

63 where

77 funcName = "Database.PostgreSQL.Simple.Notification.getNotification"

64 funcName = "Database.PostgreSQL.Simple.Notification.getNotification"

78−

65+ loop doConsume = do

79− fetch c = do

66+ res <- withConnection conn $ \c -> do

67+ when doConsume (PQ.consumeInput c >> return ())

80− mmsg <- PQ.notifies c

68+ mmsg <- PQ.notifies c

81− case mmsg of

69+ case mmsg of

82− Just msg -> return (return $! convertNotice msg)

83− Nothing -> do

70+ Nothing -> do

84− mfd <- PQ.socket c

71+ mfd <- PQ.socket c

85− case mfd of

72+ case mfd of

86− Nothing -> return (throwIO $! fdError funcName)

73+ Nothing -> throwIO $ fdError funcName

74+ Just fd -> return (Left fd)

75+ Just msg -> return (Right msg)

76+ -- FIXME? what happens if the connection is closed/reset right here?

77+ case res of

87#if defined(mingw32_HOST_OS)

78#if defined(mingw32_HOST_OS)

88− -- threadWaitRead doesn't work for sockets on Windows, so just

79+ -- threadWaitRead doesn't work for sockets on Windows, so just poll

89− -- poll for input every second (PQconsumeInput is non-blocking).

80+ -- for input every second (PQconsumeInput is non-blocking).

90− --

81+ --

91− -- We could call select(), but FFI calls can't be interrupted

82+ -- We could call select(), but FFI calls can't be interrupted with

92− -- with async exceptions, whereas threadDelay can.

83+ -- async exceptions, whereas threadDelay can.

93− Just _fd -> do

94− return (threadDelay 1000000 >> loop)

84+ Left _fd -> threadDelay 1000000 >> loop True

95#else

85#else

96− -- This case fixes the race condition above. By registering

86+ Left fd -> threadWaitRead fd >> loop True

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

110#endif

87#endif

111−

88+ Right msg -> return $! convertNotice msg

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

120-- | Non-blocking variant of 'getNotification'. Returns a single notification,

90-- | Non-blocking variant of 'getNotification'. Returns a single notification,

121-- if available. If no notifications are available, returns 'Nothing'.

91-- if available. If no notifications are available, returns 'Nothing'.

src/Database/PostgreSQL/Simple/Ok.hs+4−10

@@ -1,11 +1,10 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveFunctor #-}

3−{-# LANGUAGE CPP #-}

5------------------------------------------------------------------------------

4------------------------------------------------------------------------------

6-- |

5-- |

7-- Module : Database.PostgreSQL.Simple.Ok

6-- Module : Database.PostgreSQL.Simple.Ok

9-- License : BSD3

8-- License : BSD3

10--

9--

11-- Maintainer : leon@melding-monads.com

10-- Maintainer : leon@melding-monads.com

@@ -21,7 +20,7 @@

21-- commonly-used type and typeclass included in @base@.

20-- commonly-used type and typeclass included in @base@.

22--

21--

23-- Extending the failure case to a list of 'SomeException's enables a

22-- Extending the failure case to a list of 'SomeException's enables a

24−-- more sensible 'Alternative' instance definitions: '<|>' concatenates

23+-- more sensible 'Alternative' instance definitions: '<|>' concatinates

25-- the list of exceptions when both cases fail, and 'empty' is defined as

24-- the list of exceptions when both cases fail, and 'empty' is defined as

26-- 'Errors []'. Though '<|>' one could pick one of two exceptions, and

25-- 'Errors []'. Though '<|>' one could pick one of two exceptions, and

27-- throw away the other, and have 'empty' provide a generic exception,

26-- throw away the other, and have 'empty' provide a generic exception,

@@ -37,8 +36,6 @@ import Control.Exception

37import Control.Monad(MonadPlus(..))

36import Control.Monad(MonadPlus(..))

38import Data.Typeable

37import Data.Typeable

40−import qualified Control.Monad.Fail as Fail

41−

42-- FIXME: [SomeException] should probably be something else, maybe

39-- FIXME: [SomeException] should probably be something else, maybe

43-- a difference list (or a tree?)

40-- a difference list (or a tree?)

@@ -72,14 +69,11 @@ instance MonadPlus Ok where

72 mplus = (<|>)

69 mplus = (<|>)

74instance Monad Ok where

71instance Monad Ok where

72+ return = Ok

73+

75 Errors es >>= _ = Errors es

74 Errors es >>= _ = Errors es

76 Ok a >>= f = f a

75 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

83 fail str = Errors [SomeException (ErrorCall str)]

77 fail str = Errors [SomeException (ErrorCall str)]

85-- | a way to reify a list of exceptions into a single exception

79-- | a way to reify a list of exceptions into a single exception

src/Database/PostgreSQL/Simple/Range.hs+10−14

@@ -19,7 +19,6 @@ module Database.PostgreSQL.Simple.Range

19 , empty

20 , isEmpty, isEmptyBy

21 , contains, containsBy

22− , fromFieldRange

23 ) where

22 ) where

25import Control.Applicative hiding (empty)

24import Control.Applicative hiding (empty)

@@ -38,7 +37,7 @@ import Data.Monoid (mempty)

38import Data.Scientific (Scientific)

37import Data.Scientific (Scientific)

39import qualified Data.Text.Lazy.Builder as LT

38import qualified Data.Text.Lazy.Builder as LT

40import qualified Data.Text.Lazy.Encoding as LT

39import qualified Data.Text.Lazy.Encoding as LT

41−import Data.Time.Compat (Day, LocalTime,

40+import Data.Time (Day, LocalTime,

42 NominalDiffTime,

41 NominalDiffTime,

43 TimeOfDay, UTCTime,

42 TimeOfDay, UTCTime,

44 ZonedTime,

43 ZonedTime,

@@ -110,19 +109,19 @@ containsBy cmp rng x =

110 PGRange _lb NegInfinity -> False

109 PGRange _lb NegInfinity -> False

111 PGRange lb ub -> checkLB lb x && checkUB ub x

110 PGRange lb ub -> checkLB lb x && checkUB ub x

112 where

111 where

113− checkLB lb y =

112+ checkLB lb x =

114 case lb of

113 case lb of

115 NegInfinity -> True

114 NegInfinity -> True

116 PosInfinity -> False

115 PosInfinity -> False

117− Inclusive a -> cmp a y /= GT

116+ Inclusive a -> cmp a x /= GT

118− Exclusive a -> cmp a y == LT

117+ Exclusive a -> cmp a x == LT

119

118

120− checkUB ub y =

119+ checkUB ub x =

121 case ub of

120 case ub of

122 NegInfinity -> False

121 NegInfinity -> False

123 PosInfinity -> True

122 PosInfinity -> True

124− Inclusive z -> cmp y z /= GT

123+ Inclusive z -> cmp x z /= GT

125− Exclusive z -> cmp y z == LT

124+ Exclusive z -> cmp x z == LT

126

125

127lowerBound :: Parser (a -> RangeBound a)

126lowerBound :: Parser (a -> RangeBound a)

128lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)

127lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)

@@ -190,10 +189,7 @@ rangeToBuilderBy cmp f x =

190

189

191

190

192instance (FromField a, Typeable a) => FromField (PGRange a) where

191instance (FromField a, Typeable a) => FromField (PGRange a) where

193− fromField = fromFieldRange fromField

192+ fromField f mdat = do

194−

195−fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)

196−fromFieldRange fromField' f mdat = do

197 info <- typeInfo f

193 info <- typeInfo f

198 case info of

194 case info of

199 Range{} ->

195 Range{} ->

@@ -203,8 +199,8 @@ fromFieldRange fromField' f mdat = do

203 Just "empty" -> pure $ empty

199 Just "empty" -> pure $ empty

204 Just bs ->

200 Just bs ->

205 let parseIt NegInfinity = pure NegInfinity

201 let parseIt NegInfinity = pure NegInfinity

206− parseIt (Inclusive v) = Inclusive <$> fromField' f' (Just v)

202+ parseIt (Inclusive v) = Inclusive <$> fromField f' (Just v)

207− parseIt (Exclusive v) = Exclusive <$> fromField' f' (Just v)

203+ parseIt (Exclusive v) = Exclusive <$> fromField f' (Just v)

208 parseIt PosInfinity = pure PosInfinity

204 parseIt PosInfinity = pure PosInfinity

209 in case parseOnly pgrange bs of

205 in case parseOnly pgrange bs of

210 Left e -> returnError ConversionFailed f e

206 Left e -> returnError ConversionFailed f e

src/Database/PostgreSQL/Simple/SqlQQ.hs+9−10

@@ -1,9 +1,4 @@

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 800

3−{-# LANGUAGE TemplateHaskellQuotes #-}

4−#else

5{-# LANGUAGE TemplateHaskell #-}

1{-# LANGUAGE TemplateHaskell #-}

6−#endif

7------------------------------------------------------------------------------

2------------------------------------------------------------------------------

8-- |

3-- |

9-- Module: Database.PostgreSQL.Simple.SqlQQ

4-- Module: Database.PostgreSQL.Simple.SqlQQ

@@ -35,7 +30,7 @@ import Data.String

35-- > (beginTime,endTime,string)

30-- > (beginTime,endTime,string)

36--

31--

37-- This quasiquoter returns a literal string expression of type 'Query',

32-- This quasiquoter returns a literal string expression of type 'Query',

38−-- and attempts to minimize whitespace; otherwise the above query would

33+-- and attempts to mimimize whitespace; otherwise the above query would

39-- consist of approximately half whitespace when sent to the database

34-- consist of approximately half whitespace when sent to the database

40-- backend. It also recognizes and strips out standard sql comments "--".

35-- backend. It also recognizes and strips out standard sql comments "--".

41--

36--

@@ -57,10 +52,13 @@ import Data.String

58sql :: QuasiQuoter

53sql :: QuasiQuoter

59sql = QuasiQuoter

54sql = QuasiQuoter

60− { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in pattern context"

55+ { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

56+ \ quasiquoter used in pattern context"

61− , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in type context"

57+ , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

58+ \ quasiquoter used in type context"

62 , quoteExp = sqlExp

59 , quoteExp = sqlExp

63− , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in declaration context"

60+ , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

61+ \ quasiquoter used in declaration context"

64 }

62 }

66sqlExp :: String -> Q Exp

64sqlExp :: String -> Q Exp

@@ -87,4 +85,5 @@ minimizeSpace = drop 1 . reduceSpace

87 instring ('\'':'\'':xs) = '\'':'\'': instring xs

85 instring ('\'':'\'':xs) = '\'':'\'': instring xs

88 instring ('\'':xs) = '\'': insql xs

86 instring ('\'':xs) = '\'': insql xs

89 instring (x:xs) = x : instring xs

87 instring (x:xs) = x : instring xs

90− instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql: string literal not terminated"

88+ instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

89+ \ string literal not terminated"

src/Database/PostgreSQL/Simple/Time.hs+50−215

@@ -1,216 +1,53 @@

1−{- |

1+------------------------------------------------------------------------------

2+-- |

2−Module: Database.PostgreSQL.Simple.Time

3+-- Module: Database.PostgreSQL.Simple.Time

4−License: BSD3

5+-- License: BSD3

5−Maintainer: Leon P Smith <leon@melding-monads.com>

6+-- Maintainer: Leon P Smith <leon@melding-monads.com>

6−Stability: experimental

7+-- Stability: experimental

7−

8+--

8−This module provides time types that supports positive and negative

9+-- Time types that supports positive and negative infinity. Also includes

9−infinity, as well as some functions for converting to and from strings.

10+-- new time parsers and printers with better performance than GHC's time

10−

11+-- package.

11−Also, this module also contains commentary regarding postgresql's timestamp

12+--

12−types, civil timekeeping in general, and how it relates to

13+-- The parsers only understand the specific variant of ISO 8601 that

13−postgresql-simple. You can read more about PostgreSQL's date and time types

14+-- PostgreSQL emits, and the printers attempt to duplicate this syntax.

14−at <https://www.postgresql.org/docs/9.5/static/datatype-datetime.html>,

15+-- Thus the @datestyle@ parameter for the connection must be set to @ISO@.

15−and the IANA time zone database at <https://en.wikipedia.org/wiki/Tz_database>.

16+--

16−

17+-- These parsers and printers likely have problems and shortcomings. Some

17−Stack Overflow also has some excellent commentary on time, if it is a

18+-- that I know of:

18−wiki page or a highly upvoted question and answer. If the answer regarding

19+--

19−time has not received about a hundred upvotes at least, then the answer is

20+-- 1 @TimestampTZ@s before a timezone-dependent point in time cannot be

20−almost invariably completely and painfully wrong, even if it's the chosen

21+-- parsed, because the parsers can only handle timezone offsets of a

21−answer or the most highly upvoted answer to a question.

22+-- integer number of minutes. However, PostgreSQL will include seconds

22−

23+-- in the offset, depending on the historical time standards for the city

23−PostgreSQL's @timestamp with time zone@ (hereafter, @timestamptz@) can be

24+-- identifying the time zone.

24−converted to Haskell's 'Data.Time.UTCTime' and 'Data.Time.ZonedTime' types,

25+--

25−because values of these types represent a self-contained, unambiguous point

26+-- This boundary point often marks an event of some interest. In the US

26−in time. PostgreSQL's @timestamp without time zone@ (hereafter, @timestamp@)

27+-- for example, @timestamptz@s before @1883-Nov-18 12:00:00@ local time

27−can be converted to Haskell's 'Data.Time.LocalTime', because values of these

28+-- cannot be parsed. This is the moment Standard Railway Time went live.

28−types are ambiguous by themselves, and require context to disambiguate.

29−

30−While this behavior may be superficially counterintuitive because the

31−names might suggest otherwise, this behavior is correct. In fact,

32−the \"timezone\" language in both the postgresql and haskell types would

33−be better read as \"offset (from UTC)\", thus we have postgresql's

34−\"timestamp with offset\" corresponding to Haskell's \"time with the

35−offset \'zero\'\" and Haskell's \"time with an offset (that might be

36−nonzero)\". Similarly, postgresql's \"timestamp without an offset\"

37−corresponds to Haskell's \"local time (without an offset)\".

38−

39−It's important to distinguish between an offset, a standard time, and

40−a time zone. An offset is simply a difference of a local time from UTC,

41−such as @+00@, @-05@, or @+05:30@. A standard time specifies an offset

42−(which may vary throughout the year, due to daylight savings) that a

43−region follows, such as Universal Coordinated Time (UTC), Eastern Standard

44−Time\/Eastern Daylight Time (EST\/EDT), or India Standard Time (IST).

45−And a time zone, much like a standard time, is a function from

46−timestamps to offsets.

47−

48−A time zone is different from a standard time because different regions

49−inside a standard time can be governed by different civil authorities with

50−different laws and thus have different histories of civil time. An IANA

51−time zone is any region of the world that has had the same history of

52−civil time since @1970-01-01 00:00+00@.

53−

54−For example, as of today, both @America\/New_York@ and

55−@America\/Indiana\/Indianapolis@ are on the EST\/EDT time standard, but

56−Indiana used to be on Central Standard Time until 1942, and did not observe

57−daylight savings time (EST only) until 2006. Thus, the choice between

58−these two time zones still matters if you are dealing with timestamps

59−prior to 2006, and could become relevant again if (most of) Indiana

60−moves back to Central Time. (Of course, if the Central to Eastern switch

61−was the only difference, then these two time zones would be the same in

62−IANA's eyes, due to their cutoff date of 1970-01-01.)

63−

64−Getting back to practicalities, PostgreSQL's @timestamptz@ type does not

65−actually store an offset; rather, it uses the offset provided to calculate

66−UTC, and stores the timestamp as UTC. If an offset is not provided, the

67−given timestamp is assumed to be a local time for whatever the @timezone@

68−variable is set to, and the IANA TZ database is consulted to calculate an

69−offset from UTC for the time in question.

70−

71−Note that while most (local timestamp, time zone) pairs correspond to exactly

72−one UTC timestamp, some correspond to two UTC timestamps, while others

73−correspond to none at all. The ambiguous case occurs when the civil time

74−is rolled back, making a calendar day longer than 24 hours. In this case,

75−PostgreSQL silently chooses the second, later possibility. The inconsistent

76−case occurs when the civil time is moved forward, making a calendar day less

77−than 24 hours. In this case, PostgreSQL silently assumes the local time

78−was read off a clock that had not been moved forward at the prescribed time,

79−and moves the clock forward for you. Thus, converting from local time

80−to UTC need not be monotonic, if these inconsistent cases are allowed.

81−

82−When retrieving a @timestamptz@, the backend looks at the @time zone@

83−connection variable and then consults the IANA TZ database to calculate

84−an offset for the timestamp in the given time zone.

85−

86−Note that while some of the information contained in the IANA TZ database

87−is a bit of a standardized fiction, the conversion from UTC time to a

88−(local time, offset) pair in a particular time zone is always unambiguous,

89−and the result can always be unambiguously converted back to UTC. Thus,

90−postgresql-simple can interpret such a result as a 'Data.Time.ZonedTime',

91−or use the offset to convert back to 'Data.Time.UTCTime'.

92−

93−By contrast, the @timestamp@ type ignores any offsets provided to it,

94−and never sends back an offset. Thus, postgresql-simple equates this

95−with 'Data.Time.LocalTime', which has no concept of an offset. One can

96−convert between @timestamptz@ and @timestamp@ using the @AT TIME ZONE@

97−operator, whose semantics also demonstrates that @timestamptz@ is

98−'Data.Time.UTCTime' whereas @timestamp@ is 'Data.Time.LocalTime'.

99−

100−PostgreSQL's @timezone@ is a per-connection variable that by default is

101−initialized to @\'localtime\'@, which normally corresponds to the server's

102−time zone. However, this default can be modified on the server side for an

103−entire cluster, or on a per-user or per-database basis. Moreover, a client

104−can modify their instance of the variable at any time, and can apply that

105−change to the remaining duration of the connection, the current transaction,

106−or the execution context of a server-side function. In addition, upon

107−connection initialization, the libpq client checks for the existence of

108−the @PGTZ@ environment variable, and if it exists, modifies @timezone@

109−accordingly.

110−

111−With a few caveats, postgresql-simple is designed so that you can both send

112−and receive timestamps with the server and get a correct result, no matter

113−what the @timezone@ setting is. But it is important to understand the caveats:

114−

115−1. The correctness of server-side computations can depend on the @timezone@

116− setting. Examples include adding an @interval@ to a @timestamptz@, or

117− type casting between @timestamp@ and @timestamptz@, or applying

118− the @DATE@ function to a @timestamptz@.

119−

120−2. The (localtime, offset) pair contained in a 'Data.Time.ZonedTime' result

121− will depend on the @timezone@ setting, although the result will always

122− represent the same instant in time regardless of the time zone.

123−

124−3. Sending a 'Data.Time.LocalTime' and interpreting it as a @timestamptz@

125− can be useful, as it will be converted to UTC via the tz database,

126− but correctness will depend on the @timezone@ setting. You may prefer

127− to use an explicit @AT TIME ZONE@ conversion instead, which would avoid

128− this contextual dependence.

129−

130−Furthermore, although these following points don't involve the @timezone@

131−setting, they are related to the last point above:

132−

133−1. Sending a 'Data.Time.UTCTime' and interpreting it as a @timestamp@ can

134− be useful. In practice, the most common context used to disambiguate

135− @timestamp@ is that it represents UTC, and this coding technique will

136− work as expected in this situation.

137−

138−2. Sending a 'Data.Time.ZonedTime' and interpreting it as a @timestamp@ is

139− almost always the wrong thing to do, as the offset will be ignored and

140− discarded. This is likely to lead to inconsistencies in the database,

141− and may lead to partial data loss.

142−

143−When dealing with local timestamps that refer to the future, it is often

144−useful to store it as a local time in a @timestamp@ column and store the

145−time zone in a second column. One reason to do this is so that you can

146−convert to UTC on the fly as needed, and be protected against future changes

147−to the TZ database due to changes in local time standards. In any case,

148−'Data.Time.ZonedTime' is not suitable for this application, because despite

149−its name, it represents an offset and not a time zone. Time zones can change;

150−offsets do not. In reality, we can't convert a local timestamp that occurs

151−sufficiently far in the future to UTC, because we don't know how to do it yet.

152−

153−There are a few limitations and caveats that one might need to be aware

154−of with the current implementation when dealing with older timestamps:

155−

156−For sufficiently old timestamps in almost all time zones, the IANA TZ

157−database specifies offsets from UTC that is not an integral number of

158−minutes. This corresponds to local mean time; that is, astronomical

159−time in the city that defines the time zone. Different time zones moved

160−away from local mean time to a standard time at different points in

161−history, so \"sufficiently old\" depends on the time zone in question.

162−

163−Thus, when retrieving a @timestamptz@ postgresql will in some cases

164−provide seconds in the offset. For example:

165−

166−@

167−$ psql

168−psql (9.4.5)

169−Type \"help\" for help.

170−

171−lpsmith=> SET timezone TO \'America/New_York\';

172−SET

173−lpsmith=> VALUES (\'1883-11-18 16:59:59+00\'::timestamptz),

174− (\'1883-11-18 17:00:00+00\'::timestamptz);

175− column1

176−------------------------------

177− 1883-11-18 12:03:57-04:56:02

29+-- Concretely, PostgreSQL will emit @1883-11-18 12:03:57-04:56:02@

178− 1883-11-18 12:00:00-05

30+-- instead of @1883-11-18 11:59:59-05@ when the @timezone@ parameter

179−(2 rows)

31+-- for the connection is set to @America/New_York@.

180−@

32+--

181−

33+-- 2. Dates and times surrounding @1582-Feb-24@, the date the Gregorian

182−Both of these timestamps can be parsed as a 'Data.Time.UTCTime' type,

34+-- Calendar was introduced, should be investigated for conversion errors.

183−however 'Data.Time.ZonedTime' will fail on the former timestamp.

35+--

184−Because 'Data.Time.ZonedTime' assumes that offsets are an integer number

185−of minutes, there isn't an particularly good solution here.

186−

187−PostgreSQL, like most software, uses the proleptic Gregorian calendar

188−for its date calculations, extending the Gregorian calendar backwards

189−in time before its introduction and pretending that the Julian calendar

190−does not exist. For most purposes, the adoption of the Gregorian calendar

191−ranges from @1582-10-15@ to @1923-03-01@, depending on location and

192−sometimes even political allegiances within a single location.

193−

194−Timestamps BCE are not supported. For example, PostgreSQL

36+-- 3. Points in time Before Christ are not also not supported. For example,

195−will emit \"@0045-01-01 BC@\" for the first proleptic Gregorian day of

37+-- PostgreSQL will emit @0045-01-01 BC@ for a value of a @date@ type.

196−the year the Roman Empire adopted the Julian Calendar, but

38+-- This is the year that the Julian Calendar was adopted.

197−postgresql-simple does not (yet?) have the ability to either parse or

39+--

198−generate this syntax. Unfortunately this syntax isn't convenient to

40+-- However, it should be noted that the old parsers also had issues 1 and 3.

199−print or especially parse.

41+-- Also, the new parsers now correctly handle time zones that include minutes

200−

42+-- in their offset. Most notably, this includes all of India and parts of

201−Also, postgresql itself cannot parse or print dates before @4714-11-24 BC@,

43+-- Canada and Australia.

202−which is the Julian date on the proleptic Gregorian Calendar. Although

44+--

203−postgresql's timestamp types are perfectly capable of representing timestamps

45+-- PostgreSQL uses the zoneinfo database for its time zone information.

204−nearly 300,000 years in the past, using this would require postgresql-simple

46+-- You can read more about PostgreSQL's date and time types at

205−and other client programs to support binary parameters and results.

47+-- <http://www.postgresql.org/docs/9.1/static/datatype-datetime.html>,

206−

48+-- and zoneinfo at <http://en.wikipedia.org/wiki/Tz_database>.

207−Dealing with years BCE is also complicated slightly by the fact that

49+--

208−Haskell's time library has a year \"0000\", which is a convention often

50+------------------------------------------------------------------------------

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

215module Database.PostgreSQL.Simple.Time

52module Database.PostgreSQL.Simple.Time

216 ( Unbounded(..)

53 ( Unbounded(..)

@@ -227,7 +64,6 @@ module Database.PostgreSQL.Simple.Time

227 , parseUTCTimestamp

64 , parseUTCTimestamp

228 , parseZonedTimestamp

65 , parseZonedTimestamp

229 , parseLocalTimestamp

66 , parseLocalTimestamp

230− , parseCalendarDiffTime

231 , dayToBuilder

67 , dayToBuilder

232 , utcTimeToBuilder

68 , utcTimeToBuilder

233 , zonedTimeToBuilder

69 , zonedTimeToBuilder

@@ -240,7 +76,6 @@ module Database.PostgreSQL.Simple.Time

240 , localTimestampToBuilder

76 , localTimestampToBuilder

241 , unboundedToBuilder

77 , unboundedToBuilder

242 , nominalDiffTimeToBuilder

78 , nominalDiffTimeToBuilder

243− , calendarDiffTimeToBuilder

244 ) where

79 ) where

245

246import Database.PostgreSQL.Simple.Time.Implementation

81import Database.PostgreSQL.Simple.Time.Implementation

src/Database/PostgreSQL/Simple/Time/Implementation.hs+1−11

@@ -18,8 +18,7 @@ import Data.ByteString.Builder.Prim(primBounded)

18import Control.Arrow((***))

19import Control.Applicative

20import qualified Data.ByteString as B

21−import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)

21+import Data.Time hiding (getTimeZone, getZonedTime)

22−import Data.Time.LocalTime.Compat (CalendarDiffTime)

23import Data.Typeable

22import Data.Typeable

24import Data.Maybe (fromMaybe)

23import Data.Maybe (fromMaybe)

25import qualified Data.Attoparsec.ByteString.Char8 as A

24import qualified Data.Attoparsec.ByteString.Char8 as A

@@ -78,9 +77,6 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)

78parseDate :: B.ByteString -> Either String Date

77parseDate :: B.ByteString -> Either String Date

79parseDate = A.parseOnly (getDate <* A.endOfInput)

78parseDate = A.parseOnly (getDate <* A.endOfInput)

81−parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime

82−parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)

83−

84getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

80getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

85getUnbounded getFinite

81getUnbounded getFinite

86 = (pure NegInfinity <* A.string "-infinity")

82 = (pure NegInfinity <* A.string "-infinity")

@@ -129,9 +125,6 @@ getUTCTime = TP.utcTime

129getUTCTimestamp :: A.Parser UTCTimestamp

125getUTCTimestamp :: A.Parser UTCTimestamp

130getUTCTimestamp = getUnbounded getUTCTime

126getUTCTimestamp = getUnbounded getUTCTime

131

127

132−getCalendarDiffTime :: A.Parser CalendarDiffTime

133−getCalendarDiffTime = TP.calendarDiffTime

134−

135dayToBuilder :: Day -> Builder

128dayToBuilder :: Day -> Builder

136dayToBuilder = primBounded TPP.day

129dayToBuilder = primBounded TPP.day

137

130

@@ -171,6 +164,3 @@ dateToBuilder = unboundedToBuilder dayToBuilder

171

164

172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

173nominalDiffTimeToBuilder = TPP.nominalDiffTime

166nominalDiffTimeToBuilder = TPP.nominalDiffTime

174−

175−calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

176−calendarDiffTimeToBuilder = TPP.calendarDiffTime

src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+6−18

@@ -21,24 +21,20 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser

21 , localToUTCTimeOfDayHMS

22 , utcTime

23 , zonedTime

24− , calendarDiffTime

25 ) where

24 ) where

27import Control.Applicative ((<$>), (<*>), (<*), (*>))

26import Control.Applicative ((<$>), (<*>), (<*), (*>))

28import Database.PostgreSQL.Simple.Compat (toPico)

27import Database.PostgreSQL.Simple.Compat (toPico)

29import Data.Attoparsec.ByteString.Char8 as A

28import Data.Attoparsec.ByteString.Char8 as A

30import Data.Bits ((.&.))

29import Data.Bits ((.&.))

31−import Data.ByteString (ByteString)

32import Data.Char (ord)

30import Data.Char (ord)

33import Data.Fixed (Pico)

31import Data.Fixed (Pico)

34import Data.Int (Int64)

32import Data.Int (Int64)

35import Data.Maybe (fromMaybe)

33import Data.Maybe (fromMaybe)

36−import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)

34+import Data.Time.Calendar (Day, fromGregorianValid, addDays)

37−import Data.Time.Clock.Compat (UTCTime(..))

35+import Data.Time.Clock (UTCTime(..))

38−import Data.Time.Format.ISO8601.Compat (iso8601ParseM)

39−import Data.Time.LocalTime.Compat (CalendarDiffTime)

40import qualified Data.ByteString.Char8 as B8

36import qualified Data.ByteString.Char8 as B8

41−import qualified Data.Time.LocalTime.Compat as Local

37+import qualified Data.Time.LocalTime as Local

43-- | Parse a date of the form @YYYY-MM-DD@.

39-- | Parse a date of the form @YYYY-MM-DD@.

44day :: Parser Day

40day :: Parser Day

@@ -56,15 +52,12 @@ twoDigits = do

56 let c2d c = ord c .&. 15

52 let c2d c = ord c .&. 15

57 return $! c2d a * 10 + c2d b

53 return $! c2d a * 10 + c2d b

59−-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.

55+-- | Parse a time of the form @HH:MM:SS[.SSS]@.

60timeOfDay :: Parser Local.TimeOfDay

56timeOfDay :: Parser Local.TimeOfDay

61timeOfDay = do

57timeOfDay = do

62 h <- twoDigits <* char ':'

58 h <- twoDigits <* char ':'

63− m <- twoDigits

59+ m <- twoDigits <* char ':'

64− mc <- peekChar

65− s <- case mc of

66− Just ':' -> anyChar *> seconds

60+ s <- seconds

67− _ -> return 0

68 if h < 24 && m < 60 && s <= 60

61 if h < 24 && m < 60 && s <= 60

69 then return (Local.TimeOfDay h m s)

62 then return (Local.TimeOfDay h m s)

70 else fail "invalid time"

63 else fail "invalid time"

@@ -197,8 +190,3 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

197

190

198utc :: Local.TimeZone

191utc :: Local.TimeZone

199utc = Local.TimeZone 0 False ""

192utc = Local.TimeZone 0 False ""

200−

201−calendarDiffTime :: Parser CalendarDiffTime

202−calendarDiffTime = do

203− contents <- takeByteString

204− iso8601ParseM $ B8.unpack contents

src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+7−19

@@ -17,23 +17,19 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer

17 , localTime

18 , zonedTime

19 , nominalDiffTime

20− , calendarDiffTime

21 ) where

20 ) where

23import Control.Arrow ((>>>))

22import Control.Arrow ((>>>))

24−import Data.ByteString.Builder (Builder, byteString, integerDec)

23+import Data.ByteString.Builder (Builder, integerDec)

25import Data.ByteString.Builder.Prim

24import Data.ByteString.Builder.Prim

26 ( liftFixedToBounded, (>$<), (>*<)

25 ( liftFixedToBounded, (>$<), (>*<)

27 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

26 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

28import Data.Char ( chr )

27import Data.Char ( chr )

29import Data.Int ( Int32, Int64 )

28import Data.Int ( Int32, Int64 )

30−import Data.String (fromString)

29+import Data.Time

31−import Data.Time.Compat

32 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

30 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

33 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

31 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

34 , TimeZone, timeZoneMinutes )

32 , TimeZone, timeZoneMinutes )

35−import Data.Time.Format.ISO8601.Compat (iso8601Show)

36−import Data.Time.LocalTime.Compat (CalendarDiffTime)

37import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

33import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

38import Unsafe.Coerce (unsafeCoerce)

34import Unsafe.Coerce (unsafeCoerce)

@@ -75,7 +71,7 @@ frac = condB (== 0) emptyB ((,) '.' >$< (liftB char8 >*< trunc12))

77year :: BoundedPrim Int32

73year :: BoundedPrim Int32

78−year = condB (>= 10000) int32Dec (checkBCE >$< liftB digits4)

74+year = condB (> 10000) int32Dec (checkBCE >$< liftB digits4)

79 where

75 where

80 checkBCE :: Int32 -> Int

76 checkBCE :: Int32 -> Int

81 checkBCE y

77 checkBCE y

@@ -100,13 +96,13 @@ timeOfDay = f >$< (hh_mm_ >*< ss)

100 (liftB (fromIntegral >$< digits2) >*< frac)

96 (liftB (fromIntegral >$< digits2) >*< frac)

101

102timeZone :: BoundedPrim TimeZone

98timeZone :: BoundedPrim TimeZone

103−timeZone = timeZoneMinutes >$< tz

99+timeZone = ((`quotRem` 60) . timeZoneMinutes) >$< (liftB tzh >*< tzm)

104 where

100 where

105− tz = condB (>= 0) ((,) '+' >$< tzh) ((,) '-' . negate >$< tzh)

101+ f h = if h >= 0 then ('+', h) else (,) '-' $! (-h)

106

102

107− tzh = liftB char8 >*< ((`quotRem` 60) >$< (liftB digits2 >*< tzm))

103+ tzh = f >$< (char8 >*< digits2)

108

104

109− tzm = condB (==0) emptyB ((,) ':' >$< liftB (char8 >*< digits2))

105+ tzm = condB (==0) emptyB ((,) ':' . abs >$< liftB (char8 >*< digits2))

110

106

111utcTime :: BoundedPrim UTCTime

107utcTime :: BoundedPrim UTCTime

112utcTime = f >$< (day >*< liftB char8 >*< timeOfDay >*< liftB char8)

108utcTime = f >$< (day >*< liftB char8 >*< timeOfDay >*< liftB char8)

@@ -125,11 +121,3 @@ nominalDiffTime :: NominalDiffTime -> Builder

125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

126 where

122 where

127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

123 (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+17−42

@@ -1,6 +1,5 @@

1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}

2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3−{-# LANGUAGE PolyKinds #-}

5------------------------------------------------------------------------------

4------------------------------------------------------------------------------

6-- |

5-- |

@@ -23,7 +22,6 @@ module Database.PostgreSQL.Simple.ToField

23 , inQuotes

22 , inQuotes

24 ) where

23 ) where

26−import Control.Applicative (Const(Const))

27import qualified Data.Aeson as JSON

25import qualified Data.Aeson as JSON

28import Data.ByteString (ByteString)

26import Data.ByteString (ByteString)

29import Data.ByteString.Builder

27import Data.ByteString.Builder

@@ -32,12 +30,10 @@ import Data.ByteString.Builder

32 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

30 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

33 , floatDec, doubleDec

31 , floatDec, doubleDec

34 )

32 )

35−import Data.Functor.Identity (Identity(Identity))

36import Data.Int (Int8, Int16, Int32, Int64)

33import Data.Int (Int8, Int16, Int32, Int64)

37import Data.List (intersperse)

34import Data.List (intersperse)

38import Data.Monoid (mappend)

35import Data.Monoid (mappend)

39−import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

36+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

40−import Data.Time.LocalTime.Compat (CalendarDiffTime)

41import Data.Typeable (Typeable)

37import Data.Typeable (Typeable)

42import Data.Word (Word, Word8, Word16, Word32, Word64)

38import Data.Word (Word, Word8, Word16, Word32, Word64)

43import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

39import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

@@ -46,8 +42,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

47import qualified Data.ByteString as SB

43import qualified Data.ByteString as SB

48import qualified Data.ByteString.Lazy as LB

44import qualified Data.ByteString.Lazy as LB

49−import Data.CaseInsensitive (CI)

50−import qualified Data.CaseInsensitive as CI

51import qualified Data.Text as ST

45import qualified Data.Text as ST

52import qualified Data.Text.Encoding as ST

46import qualified Data.Text.Encoding as ST

53import qualified Data.Text.Lazy as LT

47import qualified Data.Text.Lazy as LT

@@ -59,7 +53,11 @@ import qualified Data.Vector as V

59import qualified Database.PostgreSQL.LibPQ as PQ

53import qualified Database.PostgreSQL.LibPQ as PQ

60import Database.PostgreSQL.Simple.Time

54import Database.PostgreSQL.Simple.Time

61import Data.Scientific (Scientific)

55import Data.Scientific (Scientific)

56+#if MIN_VERSION_scientific(0,3,0)

62import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

57import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

58+#else

59+import Data.Scientific (scientificBuilder)

60+#endif

63import Foreign.C.Types (CUInt(..))

61import Foreign.C.Types (CUInt(..))

65-- | How to render an element when substituting it into a query.

63-- | How to render an element when substituting it into a query.

@@ -100,14 +98,6 @@ instance ToField Action where

100 toField a = a

98 toField a = a

101 {-# INLINE toField #-}

99 {-# INLINE toField #-}

102

100

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−

111instance (ToField a) => ToField (Maybe a) where

101instance (ToField a) => ToField (Maybe a) where

112 toField Nothing = renderNull

102 toField Nothing = renderNull

113 toField (Just a) = toField a

103 toField (Just a) = toField a

@@ -240,15 +230,6 @@ instance ToField LT.Text where

240 toField = toField . LT.toStrict

230 toField = toField . LT.toStrict

241 {-# INLINE toField #-}

231 {-# INLINE toField #-}

242

232

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 #-}

252

233

253instance ToField UTCTime where

234instance ToField UTCTime where

254 toField = Plain . inQuotes . utcTimeToBuilder

235 toField = Plain . inQuotes . utcTimeToBuilder

@@ -290,20 +271,13 @@ instance ToField NominalDiffTime where

290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

271 toField = Plain . inQuotes . nominalDiffTimeToBuilder

291 {-# INLINE toField #-}

272 {-# INLINE toField #-}

292

273

293−instance ToField CalendarDiffTime where

294− toField = Plain . inQuotes . calendarDiffTimeToBuilder

295− {-# INLINE toField #-}

296−

297instance (ToField a) => ToField (PGArray a) where

274instance (ToField a) => ToField (PGArray a) where

298− toField pgArray =

275+ toField xs = Many $

299− case fromPGArray pgArray of

300− [] -> Plain (byteString "'{}'")

301− xs -> Many $

302− Plain (byteString "ARRAY[") :

276+ Plain (byteString "ARRAY[") :

303− (intersperse (Plain (char8 ',')) . map toField $ xs) ++

277+ (intersperse (Plain (char8 ',')) . map toField $ fromPGArray xs) ++

304− [Plain (char8 ']')]

278+ [Plain (char8 ']')]

305− -- Because the ARRAY[...] input syntax is being used, it is possible

279+ -- Because the ARRAY[...] input syntax is being used, it is possible

306− -- that the use of type-specific separator characters is unnecessary.

280+ -- that the use of type-specific separator characters is unnecessary.

307

281

308instance (ToField a) => ToField (Vector a) where

282instance (ToField a) => ToField (Vector a) where

309 toField = toField . PGArray . V.toList

283 toField = toField . PGArray . V.toList

@@ -314,13 +288,14 @@ instance ToField UUID where

314instance ToField JSON.Value where

288instance ToField JSON.Value where

315 toField = toField . JSON.encode

289 toField = toField . JSON.encode

316

290

317−-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.

291+-- | Convert a Haskell value to a JSON 'JSON.Value' using

292+-- 'JSON.toJSON' and convert that to a field using 'toField'.

318--

293--

319-- This can be used as the default implementation for the 'toField'

294-- This can be used as the default implementation for the 'toField'

320-- method for Haskell types that have a JSON representation in

295-- method for Haskell types that have a JSON representation in

321-- PostgreSQL.

296-- PostgreSQL.

322toJSONField :: JSON.ToJSON a => a -> Action

297toJSONField :: JSON.ToJSON a => a -> Action

323−toJSONField = toField . JSON.encode

298+toJSONField = toField . JSON.toJSON

324

299

325-- | Surround a string with single-quote characters: \"@'@\"

300-- | Surround a string with single-quote characters: \"@'@\"

326--

301--

@@ -330,7 +305,7 @@ inQuotes b = quote `mappend` b `mappend` quote

330 where quote = char8 '\''

305 where quote = char8 '\''

331

306

332interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

307interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

333−interleaveFoldr f b bs' as = foldr (\a bs -> b : f a bs) bs' as

308+interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as

334{-# INLINE interleaveFoldr #-}

309{-# INLINE interleaveFoldr #-}

335

310

336instance ToRow a => ToField (Values a) where

311instance ToRow a => ToField (Values a) where

@@ -377,8 +352,8 @@ instance ToRow a => ToField (Values a) where

377

352

378 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

353 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

379 typedRows [] _ _ = error funcname

354 typedRows [] _ _ = error funcname

380− typedRows (val:vals) typs rest =

355+ typedRows (val:vals) types rest =

381− typedRow (toRow val) typs (multiRows vals rest)

356+ typedRow (toRow val) types (multiRows vals rest)

382

357

383 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

358 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

384 untypedRows [] _ = error funcname

359 untypedRows [] _ = error funcname

src/Database/PostgreSQL/Simple/ToRow.hs−127

@@ -1,4 +1,3 @@

1−{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}

2------------------------------------------------------------------------------

1------------------------------------------------------------------------------

3-- |

2-- |

4-- Module: Database.PostgreSQL.Simple.ToRow

3-- Module: Database.PostgreSQL.Simple.ToRow

@@ -23,33 +22,14 @@ module Database.PostgreSQL.Simple.ToRow

24import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))

23import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))

25import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))

24import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))

26−import GHC.Generics

28-- | A collection type that can be turned into a list of rendering

26-- | A collection type that can be turned into a list of rendering

29-- 'Action's.

27-- 'Action's.

30--

28--

31-- Instances should use the 'toField' method of the 'ToField' class

29-- Instances should use the 'toField' method of the 'ToField' class

32-- to perform conversion of each element of the collection.

30-- 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.

49class ToRow a where

31class ToRow a where

50 toRow :: a -> [Action]

32 toRow :: a -> [Action]

51− default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

52− toRow = gtoRow . from

53 -- ^ ToField a collection of values.

33 -- ^ ToField a collection of values.

55instance ToRow () where

35instance ToRow () where

@@ -105,115 +85,8 @@ instance (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,

85 [toField a, toField b, toField c, toField d, toField e, toField f,

106 toField g, toField h, toField i, toField j]

86 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−

198instance (ToField a) => ToRow [a] where

88instance (ToField a) => ToRow [a] where

199 toRow = map toField

89 toRow = map toField

200

201instance (ToRow a, ToRow b) => ToRow (a :. b) where

91instance (ToRow a, ToRow b) => ToRow (a :. b) where

202 toRow (a :. b) = toRow a ++ toRow b

92 toRow (a :. b) = toRow a ++ toRow b

203−

204−

205−-- Type class for default implementation of ToRow using generics

206−class GToRow f where

207− gtoRow :: f p -> [Action]

208−

209−instance GToRow f => GToRow (M1 c i f) where

210− gtoRow (M1 x) = gtoRow x

211−

212−instance (GToRow f, GToRow g) => GToRow (f :*: g) where

213− gtoRow (f :*: g) = gtoRow f ++ gtoRow g

214−

215−instance (ToField a) => GToRow (K1 R a) where

216− gtoRow (K1 a) = [toField a]

217−

218−instance GToRow U1 where

219− gtoRow _ = []

src/Database/PostgreSQL/Simple/ToRow.hs-boot+1−10

@@ -1,18 +1,9 @@

1−{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}

2−module Database.PostgreSQL.Simple.ToRow (

1+module Database.PostgreSQL.Simple.ToRow where

3− ToRow(..)

4− ) where

6import Database.PostgreSQL.Simple.Types

3import Database.PostgreSQL.Simple.Types

7import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField

4import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField

8−import GHC.Generics

10class ToRow a where

6class ToRow a where

11 toRow :: a -> [Action]

7 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]

18instance ToField a => ToRow (Only a)

9instance ToField a => ToRow (Only a)

src/Database/PostgreSQL/Simple/Transaction.hs+17−35

@@ -1,14 +1,4 @@

1−{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}

1+{-# LANGUAGE RecordWildCards #-}

2−

3−------------------------------------------------------------------------------

4−-- |

5−-- Module: Database.PostgreSQL.Simple.Transaction

8−-- License: BSD3

9−-- Maintainer: Leon P Smith <leon@melding-monads.com>

10−--

11−------------------------------------------------------------------------------

13module Database.PostgreSQL.Simple.Transaction

3module Database.PostgreSQL.Simple.Transaction

14 (

4 (

@@ -17,7 +7,6 @@ module Database.PostgreSQL.Simple.Transaction

17 , withTransactionLevel

7 , withTransactionLevel

18 , withTransactionMode

8 , withTransactionMode

19 , withTransactionModeRetry

9 , withTransactionModeRetry

20− , withTransactionModeRetry'

21 , withTransactionSerializable

10 , withTransactionSerializable

22 , TransactionMode(..)

11 , TransactionMode(..)

23 , IsolationLevel(..)

12 , IsolationLevel(..)

@@ -56,7 +45,7 @@ import Database.PostgreSQL.Simple.Compat (mask, (<>))

57-- | Of the four isolation levels defined by the SQL standard,

46-- | Of the four isolation levels defined by the SQL standard,

58-- these are the three levels distinguished by PostgreSQL as of version 9.0.

47-- these are the three levels distinguished by PostgreSQL as of version 9.0.

59−-- See <https://www.postgresql.org/docs/9.5/static/transaction-iso.html>

48+-- See <http://www.postgresql.org/docs/9.1/static/transaction-iso.html>

60-- for more information. Note that prior to PostgreSQL 9.0, 'RepeatableRead'

49-- for more information. Note that prior to PostgreSQL 9.0, 'RepeatableRead'

61-- was equivalent to 'Serializable'.

50-- was equivalent to 'Serializable'.

@@ -143,48 +132,41 @@ withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a

143withTransactionMode mode conn act =

132withTransactionMode mode conn act =

144 mask $ \restore -> do

133 mask $ \restore -> do

145 beginMode mode conn

134 beginMode mode conn

146− r <- restore act `E.onException` rollback_ conn

135+ r <- restore act `E.onException` rollback conn

147 commit conn

136 commit conn

148 return r

137 return r

149

138

150−-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.

151−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

152−withTransactionModeRetry = withTransactionModeRetry'

153−

154-- | Like 'withTransactionMode', but also takes a custom callback to

139-- | Like 'withTransactionMode', but also takes a custom callback to

155−-- determine if a transaction should be retried if an exception occurs.

140+-- determine if a transaction should be retried if an 'SqlError' occurs.

156−-- If the callback returns 'True', then the transaction will be retried.

141+-- If the callback returns True, then the transaction will be retried.

157−-- If the callback returns 'False', or an exception other than an @e@

142+-- If the callback returns False, or an exception other than an 'SqlError'

158-- occurs then the transaction will be rolled back and the exception rethrown.

143-- occurs then the transaction will be rolled back and the exception rethrown.

159--

144--

160-- This is used to implement 'withTransactionSerializable'.

145-- This is used to implement 'withTransactionSerializable'.

161−withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a

146+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

162−withTransactionModeRetry' mode shouldRetry conn act =

147+withTransactionModeRetry mode shouldRetry conn act =

163 mask $ \restore ->

148 mask $ \restore ->

164 retryLoop $ E.try $ do

149 retryLoop $ E.try $ do

165− a <- restore act `E.onException` rollback_ conn

150+ a <- restore act

166 commit conn

151 commit conn

167 return a

152 return a

168 where

153 where

169− retryLoop :: IO (Either e a) -> IO a

154+ retryLoop :: IO (Either E.SomeException a) -> IO a

170 retryLoop act' = do

155 retryLoop act' = do

171 beginMode mode conn

156 beginMode mode conn

172 r <- act'

157 r <- act'

173 case r of

158 case r of

174− Left e ->

159+ Left e -> do

160+ rollback conn

175− case shouldRetry e of

161+ case fmap shouldRetry (E.fromException e) of

176− True -> retryLoop act'

162+ Just True -> retryLoop act'

177− False -> E.throwIO e

163+ _ -> E.throwIO e

178 Right a ->

164 Right a ->

179 return a

165 return a

180

166

181-- | Rollback a transaction.

167-- | Rollback a transaction.

182rollback :: Connection -> IO ()

168rollback :: Connection -> IO ()

183−rollback conn = execute_ conn "ROLLBACK" >> return ()

169+rollback conn = execute_ conn "ABORT" >> return ()

184−

185−-- | Rollback a transaction, ignoring any @IOErrors@

186−rollback_ :: Connection -> IO ()

187−rollback_ conn = rollback conn `E.catch` \(_ :: IOError) -> return ()

188

170

189-- | Commit a transaction.

171-- | Commit a transaction.

190commit :: Connection -> IO ()

172commit :: Connection -> IO ()

@@ -221,7 +203,7 @@ beginMode mode conn = do

221-- be used inside of a transaction, and provides a sort of

203-- be used inside of a transaction, and provides a sort of

222-- \"nested transaction\".

204-- \"nested transaction\".

223--

205--

224−-- See <https://www.postgresql.org/docs/9.5/static/sql-savepoint.html>

206+-- See <http://www.postgresql.org/docs/current/static/sql-savepoint.html>

225withSavepoint :: Connection -> IO a -> IO a

207withSavepoint :: Connection -> IO a -> IO a

226withSavepoint conn body =

208withSavepoint conn body =

227 mask $ \restore -> do

209 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+3−9

@@ -1,9 +1,4 @@

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 800

3−{-# LANGUAGE TemplateHaskellQuotes #-}

4−#else

5{-# LANGUAGE TemplateHaskell #-}

1{-# LANGUAGE TemplateHaskell #-}

6−#endif

8------------------------------------------------------------------------------

3------------------------------------------------------------------------------

9-- |

4-- |

@@ -27,12 +22,11 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

27import Database.PostgreSQL.Simple.Types (Oid(..))

22import Database.PostgreSQL.Simple.Types (Oid(..))

28import Language.Haskell.TH

23import Language.Haskell.TH

25+

30-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

26-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

31-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

27-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

32mkCompats :: [TypeInfo] -> ExpQ

28mkCompats :: [TypeInfo] -> ExpQ

33−mkCompats tys = do

34− x <- newName "x"

35− lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])

29+mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

36 where

30 where

37 alt :: TypeInfo -> MatchQ

31 alt :: TypeInfo -> MatchQ

38 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

32 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

@@ -44,7 +38,7 @@ mkCompats tys = do

44-- Returns an expression of type 'Oid'. Useful because GHC tends

38-- Returns an expression of type 'Oid'. Useful because GHC tends

45-- not to fold constants.

39-- not to fold constants.

46inlineTypoid :: TypeInfo -> ExpQ

40inlineTypoid :: TypeInfo -> ExpQ

47−inlineTypoid ty = conE 'Oid `appE` litE (getTypoid ty)

41+inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]

49inlineTypoidP :: TypeInfo -> PatQ

43inlineTypoidP :: TypeInfo -> PatQ

50inlineTypoidP ty = litP (getTypoid ty)

44inlineTypoidP ty = litP (getTypoid ty)

src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+114−684

@@ -19,233 +19,119 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

19 ( TypeInfo(..)

20 , staticTypeInfo

21 , bool

22− , boolOid

23 , bytea

22 , bytea

24− , byteaOid

25 , char

23 , char

26− , charOid

27 , name

24 , name

28− , nameOid

29 , int8

25 , int8

30− , int8Oid

31 , int2

26 , int2

32− , int2Oid

33 , int4

27 , int4

34− , int4Oid

35 , regproc

28 , regproc

36− , regprocOid

37 , text

29 , text

38− , textOid

39 , oid

30 , oid

40− , oidOid

41 , tid

31 , tid

42− , tidOid

43 , xid

32 , xid

44− , xidOid

45 , cid

33 , cid

46− , cidOid

47 , xml

34 , xml

48− , xmlOid

49 , point

35 , point

50− , pointOid

51 , lseg

36 , lseg

52− , lsegOid

53 , path

37 , path

54− , pathOid

55 , box

38 , box

56− , boxOid

57 , polygon

39 , polygon

58− , polygonOid

59 , line

40 , line

60− , lineOid

61 , cidr

41 , cidr

62− , cidrOid

63 , float4

42 , float4

64− , float4Oid

65 , float8

43 , float8

66− , float8Oid

67 , unknown

44 , unknown

68− , unknownOid

69 , circle

45 , circle

70− , circleOid

71 , money

46 , money

72− , moneyOid

73 , macaddr

47 , macaddr

74− , macaddrOid

75 , inet

48 , inet

76− , inetOid

77 , bpchar

49 , bpchar

78− , bpcharOid

79 , varchar

50 , varchar

80− , varcharOid

81 , date

51 , date

82− , dateOid

83 , time

52 , time

84− , timeOid

85 , timestamp

53 , timestamp

86− , timestampOid

87 , timestamptz

54 , timestamptz

88− , timestamptzOid

89 , interval

55 , interval

90− , intervalOid

91 , timetz

56 , timetz

92− , timetzOid

93 , bit

57 , bit

94− , bitOid

95 , varbit

58 , varbit

96− , varbitOid

97 , numeric

59 , numeric

98− , numericOid

99 , refcursor

60 , refcursor

100− , refcursorOid

101 , record

61 , record

102− , recordOid

103 , void

62 , void

104− , voidOid

105 , array_record

63 , array_record

106− , array_recordOid

107 , regprocedure

64 , regprocedure

108− , regprocedureOid

109 , regoper

65 , regoper

110− , regoperOid

111 , regoperator

66 , regoperator

112− , regoperatorOid

113 , regclass

67 , regclass

114− , regclassOid

115 , regtype

68 , regtype

116− , regtypeOid

117 , uuid

69 , uuid

118− , uuidOid

119 , json

70 , json

120− , jsonOid

121 , jsonb

71 , jsonb

122− , jsonbOid

123 , int2vector

72 , int2vector

124− , int2vectorOid

125 , oidvector

73 , oidvector

126− , oidvectorOid

127 , array_xml

74 , array_xml

128− , array_xmlOid

129 , array_json

75 , array_json

130− , array_jsonOid

131 , array_line

76 , array_line

132− , array_lineOid

133 , array_cidr

77 , array_cidr

134− , array_cidrOid

135 , array_circle

78 , array_circle

136− , array_circleOid

137 , array_money

79 , array_money

138− , array_moneyOid

139 , array_bool

80 , array_bool

140− , array_boolOid

141 , array_bytea

81 , array_bytea

142− , array_byteaOid

143 , array_char

82 , array_char

144− , array_charOid

145 , array_name

83 , array_name

146− , array_nameOid

147 , array_int2

84 , array_int2

148− , array_int2Oid

149 , array_int2vector

85 , array_int2vector

150− , array_int2vectorOid

151 , array_int4

86 , array_int4

152− , array_int4Oid

153 , array_regproc

87 , array_regproc

154− , array_regprocOid

155 , array_text

88 , array_text

156− , array_textOid

157 , array_tid

89 , array_tid

158− , array_tidOid

159 , array_xid

90 , array_xid

160− , array_xidOid

161 , array_cid

91 , array_cid

162− , array_cidOid

163 , array_oidvector

92 , array_oidvector

164− , array_oidvectorOid

165 , array_bpchar

93 , array_bpchar

166− , array_bpcharOid

167 , array_varchar

94 , array_varchar

168− , array_varcharOid

169 , array_int8

95 , array_int8

170− , array_int8Oid

171 , array_point

96 , array_point

172− , array_pointOid

173 , array_lseg

97 , array_lseg

174− , array_lsegOid

175 , array_path

98 , array_path

176− , array_pathOid

177 , array_box

99 , array_box

178− , array_boxOid

179 , array_float4

100 , array_float4

180− , array_float4Oid

181 , array_float8

101 , array_float8

182− , array_float8Oid

183 , array_polygon

102 , array_polygon

184− , array_polygonOid

185 , array_oid

103 , array_oid

186− , array_oidOid

187 , array_macaddr

104 , array_macaddr

188− , array_macaddrOid

189 , array_inet

105 , array_inet

190− , array_inetOid

191 , array_timestamp

106 , array_timestamp

192− , array_timestampOid

193 , array_date

107 , array_date

194− , array_dateOid

195 , array_time

108 , array_time

196− , array_timeOid

197 , array_timestamptz

109 , array_timestamptz

198− , array_timestamptzOid

199 , array_interval

110 , array_interval

200− , array_intervalOid

201 , array_numeric

111 , array_numeric

202− , array_numericOid

203 , array_timetz

112 , array_timetz

204− , array_timetzOid

205 , array_bit

113 , array_bit

206− , array_bitOid

207 , array_varbit

114 , array_varbit

208− , array_varbitOid

209 , array_refcursor

115 , array_refcursor

210− , array_refcursorOid

211 , array_regprocedure

116 , array_regprocedure

212− , array_regprocedureOid

213 , array_regoper

117 , array_regoper

214− , array_regoperOid

215 , array_regoperator

118 , array_regoperator

216− , array_regoperatorOid

217 , array_regclass

119 , array_regclass

218− , array_regclassOid

219 , array_regtype

120 , array_regtype

220− , array_regtypeOid

221 , array_uuid

121 , array_uuid

222− , array_uuidOid

223 , array_jsonb

122 , array_jsonb

224− , array_jsonbOid

225 , int4range

123 , int4range

226− , int4rangeOid

227 , _int4range

124 , _int4range

228− , _int4rangeOid

229 , numrange

125 , numrange

230− , numrangeOid

231 , _numrange

126 , _numrange

232− , _numrangeOid

233 , tsrange

127 , tsrange

234− , tsrangeOid

235 , _tsrange

128 , _tsrange

236− , _tsrangeOid

237 , tstzrange

129 , tstzrange

238− , tstzrangeOid

239 , _tstzrange

130 , _tstzrange

240− , _tstzrangeOid

241 , daterange

131 , daterange

242− , daterangeOid

243 , _daterange

132 , _daterange

244− , _daterangeOid

245 , int8range

133 , int8range

246− , int8rangeOid

247 , _int8range

134 , _int8range

248− , _int8rangeOid

249 ) where

135 ) where

250

136

251import Database.PostgreSQL.LibPQ (Oid(..))

137import Database.PostgreSQL.LibPQ (Oid(..))

@@ -371,1432 +257,976 @@ staticTypeInfo (Oid x) = case x of

371

257

372bool :: TypeInfo

258bool :: TypeInfo

373bool = Basic {

259bool = Basic {

374− typoid = boolOid,

260+ typoid = Oid 16,

375 typcategory = 'B',

261 typcategory = 'B',

376 typdelim = ',',

262 typdelim = ',',

377 typname = "bool"

263 typname = "bool"

378 }

264 }

379

265

380−boolOid :: Oid

381−boolOid = Oid 16

382−{-# INLINE boolOid #-}

383−

384bytea :: TypeInfo

266bytea :: TypeInfo

385bytea = Basic {

267bytea = Basic {

386− typoid = byteaOid,

268+ typoid = Oid 17,

387 typcategory = 'U',

269 typcategory = 'U',

388 typdelim = ',',

270 typdelim = ',',

389 typname = "bytea"

271 typname = "bytea"

390 }

272 }

391

273

392−byteaOid :: Oid

393−byteaOid = Oid 17

394−{-# INLINE byteaOid #-}

395−

396char :: TypeInfo

274char :: TypeInfo

397char = Basic {

275char = Basic {

398− typoid = charOid,

276+ typoid = Oid 18,

399 typcategory = 'S',

277 typcategory = 'S',

400 typdelim = ',',

278 typdelim = ',',

401 typname = "char"

279 typname = "char"

402 }

280 }

403

281

404−charOid :: Oid

405−charOid = Oid 18

406−{-# INLINE charOid #-}

407−

408name :: TypeInfo

282name :: TypeInfo

409name = Basic {

283name = Basic {

410− typoid = nameOid,

284+ typoid = Oid 19,

411 typcategory = 'S',

285 typcategory = 'S',

412 typdelim = ',',

286 typdelim = ',',

413 typname = "name"

287 typname = "name"

414 }

288 }

415

289

416−nameOid :: Oid

417−nameOid = Oid 19

418−{-# INLINE nameOid #-}

419−

420int8 :: TypeInfo

290int8 :: TypeInfo

421int8 = Basic {

291int8 = Basic {

422− typoid = int8Oid,

292+ typoid = Oid 20,

423 typcategory = 'N',

293 typcategory = 'N',

424 typdelim = ',',

294 typdelim = ',',

425 typname = "int8"

295 typname = "int8"

426 }

296 }

427

297

428−int8Oid :: Oid

429−int8Oid = Oid 20

430−{-# INLINE int8Oid #-}

431−

432int2 :: TypeInfo

298int2 :: TypeInfo

433int2 = Basic {

299int2 = Basic {

434− typoid = int2Oid,

300+ typoid = Oid 21,

435 typcategory = 'N',

301 typcategory = 'N',

436 typdelim = ',',

302 typdelim = ',',

437 typname = "int2"

303 typname = "int2"

438 }

304 }

439

305

440−int2Oid :: Oid

441−int2Oid = Oid 21

442−{-# INLINE int2Oid #-}

443−

444int4 :: TypeInfo

306int4 :: TypeInfo

445int4 = Basic {

307int4 = Basic {

446− typoid = int4Oid,

308+ typoid = Oid 23,

447 typcategory = 'N',

309 typcategory = 'N',

448 typdelim = ',',

310 typdelim = ',',

449 typname = "int4"

311 typname = "int4"

450 }

312 }

451

313

452−int4Oid :: Oid

453−int4Oid = Oid 23

454−{-# INLINE int4Oid #-}

455−

456regproc :: TypeInfo

314regproc :: TypeInfo

457regproc = Basic {

315regproc = Basic {

458− typoid = regprocOid,

316+ typoid = Oid 24,

459 typcategory = 'N',

317 typcategory = 'N',

460 typdelim = ',',

318 typdelim = ',',

461 typname = "regproc"

319 typname = "regproc"

462 }

320 }

463

321

464−regprocOid :: Oid

465−regprocOid = Oid 24

466−{-# INLINE regprocOid #-}

467−

468text :: TypeInfo

322text :: TypeInfo

469text = Basic {

323text = Basic {

470− typoid = textOid,

324+ typoid = Oid 25,

471 typcategory = 'S',

325 typcategory = 'S',

472 typdelim = ',',

326 typdelim = ',',

473 typname = "text"

327 typname = "text"

474 }

328 }

475

329

476−textOid :: Oid

477−textOid = Oid 25

478−{-# INLINE textOid #-}

479−

480oid :: TypeInfo

330oid :: TypeInfo

481oid = Basic {

331oid = Basic {

482− typoid = oidOid,

332+ typoid = Oid 26,

483 typcategory = 'N',

333 typcategory = 'N',

484 typdelim = ',',

334 typdelim = ',',

485 typname = "oid"

335 typname = "oid"

486 }

336 }

487

337

488−oidOid :: Oid

489−oidOid = Oid 26

490−{-# INLINE oidOid #-}

491−

492tid :: TypeInfo

338tid :: TypeInfo

493tid = Basic {

339tid = Basic {

494− typoid = tidOid,

340+ typoid = Oid 27,

495 typcategory = 'U',

341 typcategory = 'U',

496 typdelim = ',',

342 typdelim = ',',

497 typname = "tid"

343 typname = "tid"

498 }

344 }

499

345

500−tidOid :: Oid

501−tidOid = Oid 27

502−{-# INLINE tidOid #-}

503−

504xid :: TypeInfo

346xid :: TypeInfo

505xid = Basic {

347xid = Basic {

506− typoid = xidOid,

348+ typoid = Oid 28,

507 typcategory = 'U',

349 typcategory = 'U',

508 typdelim = ',',

350 typdelim = ',',

509 typname = "xid"

351 typname = "xid"

510 }

352 }

511

353

512−xidOid :: Oid

513−xidOid = Oid 28

514−{-# INLINE xidOid #-}

515−

516cid :: TypeInfo

354cid :: TypeInfo

517cid = Basic {

355cid = Basic {

518− typoid = cidOid,

356+ typoid = Oid 29,

519 typcategory = 'U',

357 typcategory = 'U',

520 typdelim = ',',

358 typdelim = ',',

521 typname = "cid"

359 typname = "cid"

522 }

360 }

523

361

524−cidOid :: Oid

525−cidOid = Oid 29

526−{-# INLINE cidOid #-}

527−

528xml :: TypeInfo

362xml :: TypeInfo

529xml = Basic {

363xml = Basic {

530− typoid = xmlOid,

364+ typoid = Oid 142,

531 typcategory = 'U',

365 typcategory = 'U',

532 typdelim = ',',

366 typdelim = ',',

533 typname = "xml"

367 typname = "xml"

534 }

368 }

535

369

536−xmlOid :: Oid

537−xmlOid = Oid 142

538−{-# INLINE xmlOid #-}

539−

540point :: TypeInfo

370point :: TypeInfo

541point = Basic {

371point = Basic {

542− typoid = pointOid,

372+ typoid = Oid 600,

543 typcategory = 'G',

373 typcategory = 'G',

544 typdelim = ',',

374 typdelim = ',',

545 typname = "point"

375 typname = "point"

546 }

376 }

547

377

548−pointOid :: Oid

549−pointOid = Oid 600

550−{-# INLINE pointOid #-}

551−

552lseg :: TypeInfo

378lseg :: TypeInfo

553lseg = Basic {

379lseg = Basic {

554− typoid = lsegOid,

380+ typoid = Oid 601,

555 typcategory = 'G',

381 typcategory = 'G',

556 typdelim = ',',

382 typdelim = ',',

557 typname = "lseg"

383 typname = "lseg"

558 }

384 }

559

385

560−lsegOid :: Oid

561−lsegOid = Oid 601

562−{-# INLINE lsegOid #-}

563−

564path :: TypeInfo

386path :: TypeInfo

565path = Basic {

387path = Basic {

566− typoid = pathOid,

388+ typoid = Oid 602,

567 typcategory = 'G',

389 typcategory = 'G',

568 typdelim = ',',

390 typdelim = ',',

569 typname = "path"

391 typname = "path"

570 }

392 }

571

393

572−pathOid :: Oid

573−pathOid = Oid 602

574−{-# INLINE pathOid #-}

575−

576box :: TypeInfo

394box :: TypeInfo

577box = Basic {

395box = Basic {

578− typoid = boxOid,

396+ typoid = Oid 603,

579 typcategory = 'G',

397 typcategory = 'G',

580 typdelim = ';',

398 typdelim = ';',

581 typname = "box"

399 typname = "box"

582 }

400 }

583

401

584−boxOid :: Oid

585−boxOid = Oid 603

586−{-# INLINE boxOid #-}

587−

588polygon :: TypeInfo

402polygon :: TypeInfo

589polygon = Basic {

403polygon = Basic {

590− typoid = polygonOid,

404+ typoid = Oid 604,

591 typcategory = 'G',

405 typcategory = 'G',

592 typdelim = ',',

406 typdelim = ',',

593 typname = "polygon"

407 typname = "polygon"

594 }

408 }

595

409

596−polygonOid :: Oid

597−polygonOid = Oid 604

598−{-# INLINE polygonOid #-}

599−

600line :: TypeInfo

410line :: TypeInfo

601line = Basic {

411line = Basic {

602− typoid = lineOid,

412+ typoid = Oid 628,

603 typcategory = 'G',

413 typcategory = 'G',

604 typdelim = ',',

414 typdelim = ',',

605 typname = "line"

415 typname = "line"

606 }

416 }

607

417

608−lineOid :: Oid

609−lineOid = Oid 628

610−{-# INLINE lineOid #-}

611−

612cidr :: TypeInfo

418cidr :: TypeInfo

613cidr = Basic {

419cidr = Basic {

614− typoid = cidrOid,

420+ typoid = Oid 650,

615 typcategory = 'I',

421 typcategory = 'I',

616 typdelim = ',',

422 typdelim = ',',

617 typname = "cidr"

423 typname = "cidr"

618 }

424 }

619

425

620−cidrOid :: Oid

621−cidrOid = Oid 650

622−{-# INLINE cidrOid #-}

623−

624float4 :: TypeInfo

426float4 :: TypeInfo

625float4 = Basic {

427float4 = Basic {

626− typoid = float4Oid,

428+ typoid = Oid 700,

627 typcategory = 'N',

429 typcategory = 'N',

628 typdelim = ',',

430 typdelim = ',',

629 typname = "float4"

431 typname = "float4"

630 }

432 }

631

433

632−float4Oid :: Oid

633−float4Oid = Oid 700

634−{-# INLINE float4Oid #-}

635−

636float8 :: TypeInfo

434float8 :: TypeInfo

637float8 = Basic {

435float8 = Basic {

638− typoid = float8Oid,

436+ typoid = Oid 701,

639 typcategory = 'N',

437 typcategory = 'N',

640 typdelim = ',',

438 typdelim = ',',

641 typname = "float8"

439 typname = "float8"

642 }

440 }

643

441

644−float8Oid :: Oid

645−float8Oid = Oid 701

646−{-# INLINE float8Oid #-}

647−

648unknown :: TypeInfo

442unknown :: TypeInfo

649unknown = Basic {

443unknown = Basic {

650− typoid = unknownOid,

444+ typoid = Oid 705,

651 typcategory = 'X',

445 typcategory = 'X',

652 typdelim = ',',

446 typdelim = ',',

653 typname = "unknown"

447 typname = "unknown"

654 }

448 }

655

449

656−unknownOid :: Oid

657−unknownOid = Oid 705

658−{-# INLINE unknownOid #-}

659−

660circle :: TypeInfo

450circle :: TypeInfo

661circle = Basic {

451circle = Basic {

662− typoid = circleOid,

452+ typoid = Oid 718,

663 typcategory = 'G',

453 typcategory = 'G',

664 typdelim = ',',

454 typdelim = ',',

665 typname = "circle"

455 typname = "circle"

666 }

456 }

667

457

668−circleOid :: Oid

669−circleOid = Oid 718

670−{-# INLINE circleOid #-}

671−

672money :: TypeInfo

458money :: TypeInfo

673money = Basic {

459money = Basic {

674− typoid = moneyOid,

460+ typoid = Oid 790,

675 typcategory = 'N',

461 typcategory = 'N',

676 typdelim = ',',

462 typdelim = ',',

677 typname = "money"

463 typname = "money"

678 }

464 }

679

465

680−moneyOid :: Oid

681−moneyOid = Oid 790

682−{-# INLINE moneyOid #-}

683−

684macaddr :: TypeInfo

466macaddr :: TypeInfo

685macaddr = Basic {

467macaddr = Basic {

686− typoid = macaddrOid,

468+ typoid = Oid 829,

687 typcategory = 'U',

469 typcategory = 'U',

688 typdelim = ',',

470 typdelim = ',',

689 typname = "macaddr"

471 typname = "macaddr"

690 }

472 }

691

473

692−macaddrOid :: Oid

693−macaddrOid = Oid 829

694−{-# INLINE macaddrOid #-}

695−

696inet :: TypeInfo

474inet :: TypeInfo

697inet = Basic {

475inet = Basic {

698− typoid = inetOid,

476+ typoid = Oid 869,

699 typcategory = 'I',

477 typcategory = 'I',

700 typdelim = ',',

478 typdelim = ',',

701 typname = "inet"

479 typname = "inet"

702 }

480 }

703

481

704−inetOid :: Oid

705−inetOid = Oid 869

706−{-# INLINE inetOid #-}

707−

708bpchar :: TypeInfo

482bpchar :: TypeInfo

709bpchar = Basic {

483bpchar = Basic {

710− typoid = bpcharOid,

484+ typoid = Oid 1042,

711 typcategory = 'S',

485 typcategory = 'S',

712 typdelim = ',',

486 typdelim = ',',

713 typname = "bpchar"

487 typname = "bpchar"

714 }

488 }

715

489

716−bpcharOid :: Oid

717−bpcharOid = Oid 1042

718−{-# INLINE bpcharOid #-}

719−

720varchar :: TypeInfo

490varchar :: TypeInfo

721varchar = Basic {

491varchar = Basic {

722− typoid = varcharOid,

492+ typoid = Oid 1043,

723 typcategory = 'S',

493 typcategory = 'S',

724 typdelim = ',',

494 typdelim = ',',

725 typname = "varchar"

495 typname = "varchar"

726 }

496 }

727

497

728−varcharOid :: Oid

729−varcharOid = Oid 1043

730−{-# INLINE varcharOid #-}

731−

732date :: TypeInfo

498date :: TypeInfo

733date = Basic {

499date = Basic {

734− typoid = dateOid,

500+ typoid = Oid 1082,

735 typcategory = 'D',

501 typcategory = 'D',

736 typdelim = ',',

502 typdelim = ',',

737 typname = "date"

503 typname = "date"

738 }

504 }

739

505

740−dateOid :: Oid

741−dateOid = Oid 1082

742−{-# INLINE dateOid #-}

743−

744time :: TypeInfo

506time :: TypeInfo

745time = Basic {

507time = Basic {

746− typoid = timeOid,

508+ typoid = Oid 1083,

747 typcategory = 'D',

509 typcategory = 'D',

748 typdelim = ',',

510 typdelim = ',',

749 typname = "time"

511 typname = "time"

750 }

512 }

751

513

752−timeOid :: Oid

753−timeOid = Oid 1083

754−{-# INLINE timeOid #-}

755−

756timestamp :: TypeInfo

514timestamp :: TypeInfo

757timestamp = Basic {

515timestamp = Basic {

758− typoid = timestampOid,

516+ typoid = Oid 1114,

759 typcategory = 'D',

517 typcategory = 'D',

760 typdelim = ',',

518 typdelim = ',',

761 typname = "timestamp"

519 typname = "timestamp"

762 }

520 }

763

521

764−timestampOid :: Oid

765−timestampOid = Oid 1114

766−{-# INLINE timestampOid #-}

767−

768timestamptz :: TypeInfo

522timestamptz :: TypeInfo

769timestamptz = Basic {

523timestamptz = Basic {

770− typoid = timestamptzOid,

524+ typoid = Oid 1184,

771 typcategory = 'D',

525 typcategory = 'D',

772 typdelim = ',',

526 typdelim = ',',

773 typname = "timestamptz"

527 typname = "timestamptz"

774 }

528 }

775

529

776−timestamptzOid :: Oid

777−timestamptzOid = Oid 1184

778−{-# INLINE timestamptzOid #-}

779−

780interval :: TypeInfo

530interval :: TypeInfo

781interval = Basic {

531interval = Basic {

782− typoid = intervalOid,

532+ typoid = Oid 1186,

783 typcategory = 'T',

533 typcategory = 'T',

784 typdelim = ',',

534 typdelim = ',',

785 typname = "interval"

535 typname = "interval"

786 }

536 }

787

537

788−intervalOid :: Oid

789−intervalOid = Oid 1186

790−{-# INLINE intervalOid #-}

791−

792timetz :: TypeInfo

538timetz :: TypeInfo

793timetz = Basic {

539timetz = Basic {

794− typoid = timetzOid,

540+ typoid = Oid 1266,

795 typcategory = 'D',

541 typcategory = 'D',

796 typdelim = ',',

542 typdelim = ',',

797 typname = "timetz"

543 typname = "timetz"

798 }

544 }

799

545

800−timetzOid :: Oid

801−timetzOid = Oid 1266

802−{-# INLINE timetzOid #-}

803−

804bit :: TypeInfo

546bit :: TypeInfo

805bit = Basic {

547bit = Basic {

806− typoid = bitOid,

548+ typoid = Oid 1560,

807 typcategory = 'V',

549 typcategory = 'V',

808 typdelim = ',',

550 typdelim = ',',

809 typname = "bit"

551 typname = "bit"

810 }

552 }

811

553

812−bitOid :: Oid

813−bitOid = Oid 1560

814−{-# INLINE bitOid #-}

815−

816varbit :: TypeInfo

554varbit :: TypeInfo

817varbit = Basic {

555varbit = Basic {

818− typoid = varbitOid,

556+ typoid = Oid 1562,

819 typcategory = 'V',

557 typcategory = 'V',

820 typdelim = ',',

558 typdelim = ',',

821 typname = "varbit"

559 typname = "varbit"

822 }

560 }

823

561

824−varbitOid :: Oid

825−varbitOid = Oid 1562

826−{-# INLINE varbitOid #-}

827−

828numeric :: TypeInfo

562numeric :: TypeInfo

829numeric = Basic {

563numeric = Basic {

830− typoid = numericOid,

564+ typoid = Oid 1700,

831 typcategory = 'N',

565 typcategory = 'N',

832 typdelim = ',',

566 typdelim = ',',

833 typname = "numeric"

567 typname = "numeric"

834 }

568 }

835

569

836−numericOid :: Oid

837−numericOid = Oid 1700

838−{-# INLINE numericOid #-}

839−

840refcursor :: TypeInfo

570refcursor :: TypeInfo

841refcursor = Basic {

571refcursor = Basic {

842− typoid = refcursorOid,

572+ typoid = Oid 1790,

843 typcategory = 'U',

573 typcategory = 'U',

844 typdelim = ',',

574 typdelim = ',',

845 typname = "refcursor"

575 typname = "refcursor"

846 }

576 }

847

577

848−refcursorOid :: Oid

849−refcursorOid = Oid 1790

850−{-# INLINE refcursorOid #-}

851−

852record :: TypeInfo

578record :: TypeInfo

853record = Basic {

579record = Basic {

854− typoid = recordOid,

580+ typoid = Oid 2249,

855 typcategory = 'P',

581 typcategory = 'P',

856 typdelim = ',',

582 typdelim = ',',

857 typname = "record"

583 typname = "record"

858 }

584 }

859

585

860−recordOid :: Oid

861−recordOid = Oid 2249

862−{-# INLINE recordOid #-}

863−

864void :: TypeInfo

586void :: TypeInfo

865void = Basic {

587void = Basic {

866− typoid = voidOid,

588+ typoid = Oid 2278,

867 typcategory = 'P',

589 typcategory = 'P',

868 typdelim = ',',

590 typdelim = ',',

869 typname = "void"

591 typname = "void"

870 }

592 }

871

593

872−voidOid :: Oid

873−voidOid = Oid 2278

874−{-# INLINE voidOid #-}

875−

876array_record :: TypeInfo

594array_record :: TypeInfo

877array_record = Array {

595array_record = Array {

878− typoid = array_recordOid,

596+ typoid = Oid 2287,

879 typcategory = 'P',

597 typcategory = 'P',

880 typdelim = ',',

598 typdelim = ',',

881 typname = "_record",

599 typname = "_record",

882 typelem = record

600 typelem = record

883 }

601 }

884

602

885−array_recordOid :: Oid

886−array_recordOid = Oid 2287

887−{-# INLINE array_recordOid #-}

888−

889regprocedure :: TypeInfo

603regprocedure :: TypeInfo

890regprocedure = Basic {

604regprocedure = Basic {

891− typoid = regprocedureOid,

605+ typoid = Oid 2202,

892 typcategory = 'N',

606 typcategory = 'N',

893 typdelim = ',',

607 typdelim = ',',

894 typname = "regprocedure"

608 typname = "regprocedure"

895 }

609 }

896

610

897−regprocedureOid :: Oid

898−regprocedureOid = Oid 2202

899−{-# INLINE regprocedureOid #-}

900−

901regoper :: TypeInfo

611regoper :: TypeInfo

902regoper = Basic {

612regoper = Basic {

903− typoid = regoperOid,

613+ typoid = Oid 2203,

904 typcategory = 'N',

614 typcategory = 'N',

905 typdelim = ',',

615 typdelim = ',',

906 typname = "regoper"

616 typname = "regoper"

907 }

617 }

908

618

909−regoperOid :: Oid

910−regoperOid = Oid 2203

911−{-# INLINE regoperOid #-}

912−

913regoperator :: TypeInfo

619regoperator :: TypeInfo

914regoperator = Basic {

620regoperator = Basic {

915− typoid = regoperatorOid,

621+ typoid = Oid 2204,

916 typcategory = 'N',

622 typcategory = 'N',

917 typdelim = ',',

623 typdelim = ',',

918 typname = "regoperator"

624 typname = "regoperator"

919 }

625 }

920

626

921−regoperatorOid :: Oid

922−regoperatorOid = Oid 2204

923−{-# INLINE regoperatorOid #-}

924−

925regclass :: TypeInfo

627regclass :: TypeInfo

926regclass = Basic {

628regclass = Basic {

927− typoid = regclassOid,

629+ typoid = Oid 2205,

928 typcategory = 'N',

630 typcategory = 'N',

929 typdelim = ',',

631 typdelim = ',',

930 typname = "regclass"

632 typname = "regclass"

931 }

633 }

932

634

933−regclassOid :: Oid

934−regclassOid = Oid 2205

935−{-# INLINE regclassOid #-}

936−

937regtype :: TypeInfo

635regtype :: TypeInfo

938regtype = Basic {

636regtype = Basic {

939− typoid = regtypeOid,

637+ typoid = Oid 2206,

940 typcategory = 'N',

638 typcategory = 'N',

941 typdelim = ',',

639 typdelim = ',',

942 typname = "regtype"

640 typname = "regtype"

943 }

641 }

944

642

945−regtypeOid :: Oid

946−regtypeOid = Oid 2206

947−{-# INLINE regtypeOid #-}

948−

949uuid :: TypeInfo

643uuid :: TypeInfo

950uuid = Basic {

644uuid = Basic {

951− typoid = uuidOid,

645+ typoid = Oid 2950,

952 typcategory = 'U',

646 typcategory = 'U',

953 typdelim = ',',

647 typdelim = ',',

954 typname = "uuid"

648 typname = "uuid"

955 }

649 }

956

650

957−uuidOid :: Oid

958−uuidOid = Oid 2950

959−{-# INLINE uuidOid #-}

960−

961json :: TypeInfo

651json :: TypeInfo

962json = Basic {

652json = Basic {

963− typoid = jsonOid,

653+ typoid = Oid 114,

964 typcategory = 'U',

654 typcategory = 'U',

965 typdelim = ',',

655 typdelim = ',',

966 typname = "json"

656 typname = "json"

967 }

657 }

968

658

969−jsonOid :: Oid

970−jsonOid = Oid 114

971−{-# INLINE jsonOid #-}

972−

973jsonb :: TypeInfo

659jsonb :: TypeInfo

974jsonb = Basic {

660jsonb = Basic {

975− typoid = jsonbOid,

661+ typoid = Oid 3802,

976 typcategory = 'U',

662 typcategory = 'U',

977 typdelim = ',',

663 typdelim = ',',

978 typname = "jsonb"

664 typname = "jsonb"

979 }

665 }

980

666

981−jsonbOid :: Oid

982−jsonbOid = Oid 3802

983−{-# INLINE jsonbOid #-}

984−

985int2vector :: TypeInfo

667int2vector :: TypeInfo

986int2vector = Array {

668int2vector = Array {

987− typoid = int2vectorOid,

669+ typoid = Oid 22,

988 typcategory = 'A',

670 typcategory = 'A',

989 typdelim = ',',

671 typdelim = ',',

990 typname = "int2vector",

672 typname = "int2vector",

991 typelem = int2

673 typelem = int2

992 }

674 }

993

675

994−int2vectorOid :: Oid

995−int2vectorOid = Oid 22

996−{-# INLINE int2vectorOid #-}

997−

998oidvector :: TypeInfo

676oidvector :: TypeInfo

999oidvector = Array {

677oidvector = Array {

1000− typoid = oidvectorOid,

678+ typoid = Oid 30,

1001 typcategory = 'A',

679 typcategory = 'A',

1002 typdelim = ',',

680 typdelim = ',',

1003 typname = "oidvector",

681 typname = "oidvector",

1004 typelem = oid

682 typelem = oid

1005 }

683 }

1006

684

1007−oidvectorOid :: Oid

1008−oidvectorOid = Oid 30

1009−{-# INLINE oidvectorOid #-}

1010−

1011array_xml :: TypeInfo

685array_xml :: TypeInfo

1012array_xml = Array {

686array_xml = Array {

1013− typoid = array_xmlOid,

687+ typoid = Oid 143,

1014 typcategory = 'A',

688 typcategory = 'A',

1015 typdelim = ',',

689 typdelim = ',',

1016 typname = "_xml",

690 typname = "_xml",

1017 typelem = xml

691 typelem = xml

1018 }

692 }

1019

693

1020−array_xmlOid :: Oid

1021−array_xmlOid = Oid 143

1022−{-# INLINE array_xmlOid #-}

1023−

1024array_json :: TypeInfo

694array_json :: TypeInfo

1025array_json = Array {

695array_json = Array {

1026− typoid = array_jsonOid,

696+ typoid = Oid 199,

1027 typcategory = 'A',

697 typcategory = 'A',

1028 typdelim = ',',

698 typdelim = ',',

1029 typname = "_json",

699 typname = "_json",

1030 typelem = json

700 typelem = json

1031 }

701 }

1032

702

1033−array_jsonOid :: Oid

1034−array_jsonOid = Oid 199

1035−{-# INLINE array_jsonOid #-}

1036−

1037array_line :: TypeInfo

703array_line :: TypeInfo

1038array_line = Array {

704array_line = Array {

1039− typoid = array_lineOid,

705+ typoid = Oid 629,

1040 typcategory = 'A',

706 typcategory = 'A',

1041 typdelim = ',',

707 typdelim = ',',

1042 typname = "_line",

708 typname = "_line",

1043 typelem = line

709 typelem = line

1044 }

710 }

1045

711

1046−array_lineOid :: Oid

1047−array_lineOid = Oid 629

1048−{-# INLINE array_lineOid #-}

1049−

1050array_cidr :: TypeInfo

712array_cidr :: TypeInfo

1051array_cidr = Array {

713array_cidr = Array {

1052− typoid = array_cidrOid,

714+ typoid = Oid 651,

1053 typcategory = 'A',

715 typcategory = 'A',

1054 typdelim = ',',

716 typdelim = ',',

1055 typname = "_cidr",

717 typname = "_cidr",

1056 typelem = cidr

718 typelem = cidr

1057 }

719 }

1058

720

1059−array_cidrOid :: Oid

1060−array_cidrOid = Oid 651

1061−{-# INLINE array_cidrOid #-}

1062−

1063array_circle :: TypeInfo

721array_circle :: TypeInfo

1064array_circle = Array {

722array_circle = Array {

1065− typoid = array_circleOid,

723+ typoid = Oid 719,

1066 typcategory = 'A',

724 typcategory = 'A',

1067 typdelim = ',',

725 typdelim = ',',

1068 typname = "_circle",

726 typname = "_circle",

1069 typelem = circle

727 typelem = circle

1070 }

728 }

1071

729

1072−array_circleOid :: Oid

1073−array_circleOid = Oid 719

1074−{-# INLINE array_circleOid #-}

1075−

1076array_money :: TypeInfo

730array_money :: TypeInfo

1077array_money = Array {

731array_money = Array {

1078− typoid = array_moneyOid,

732+ typoid = Oid 791,

1079 typcategory = 'A',

733 typcategory = 'A',

1080 typdelim = ',',

734 typdelim = ',',

1081 typname = "_money",

735 typname = "_money",

1082 typelem = money

736 typelem = money

1083 }

737 }

1084

738

1085−array_moneyOid :: Oid

1086−array_moneyOid = Oid 791

1087−{-# INLINE array_moneyOid #-}

1088−

1089array_bool :: TypeInfo

739array_bool :: TypeInfo

1090array_bool = Array {

740array_bool = Array {

1091− typoid = array_boolOid,

741+ typoid = Oid 1000,

1092 typcategory = 'A',

742 typcategory = 'A',

1093 typdelim = ',',

743 typdelim = ',',

1094 typname = "_bool",

744 typname = "_bool",

1095 typelem = bool

745 typelem = bool

1096 }

746 }

1097

747

1098−array_boolOid :: Oid

1099−array_boolOid = Oid 1000

1100−{-# INLINE array_boolOid #-}

1101−

1102array_bytea :: TypeInfo

748array_bytea :: TypeInfo

1103array_bytea = Array {

749array_bytea = Array {

1104− typoid = array_byteaOid,

750+ typoid = Oid 1001,

1105 typcategory = 'A',

751 typcategory = 'A',

1106 typdelim = ',',

752 typdelim = ',',

1107 typname = "_bytea",

753 typname = "_bytea",

1108 typelem = bytea

754 typelem = bytea

1109 }

755 }

1110

756

1111−array_byteaOid :: Oid

1112−array_byteaOid = Oid 1001

1113−{-# INLINE array_byteaOid #-}

1114−

1115array_char :: TypeInfo

757array_char :: TypeInfo

1116array_char = Array {

758array_char = Array {

1117− typoid = array_charOid,

759+ typoid = Oid 1002,

1118 typcategory = 'A',

760 typcategory = 'A',

1119 typdelim = ',',

761 typdelim = ',',

1120 typname = "_char",

762 typname = "_char",

1121 typelem = char

763 typelem = char

1122 }

764 }

1123

765

1124−array_charOid :: Oid

1125−array_charOid = Oid 1002

1126−{-# INLINE array_charOid #-}

1127−

1128array_name :: TypeInfo

766array_name :: TypeInfo

1129array_name = Array {

767array_name = Array {

1130− typoid = array_nameOid,

768+ typoid = Oid 1003,

1131 typcategory = 'A',

769 typcategory = 'A',

1132 typdelim = ',',

770 typdelim = ',',

1133 typname = "_name",

771 typname = "_name",

1134 typelem = name

772 typelem = name

1135 }

773 }

1136

774

1137−array_nameOid :: Oid

1138−array_nameOid = Oid 1003

1139−{-# INLINE array_nameOid #-}

1140−

1141array_int2 :: TypeInfo

775array_int2 :: TypeInfo

1142array_int2 = Array {

776array_int2 = Array {

1143− typoid = array_int2Oid,

777+ typoid = Oid 1005,

1144 typcategory = 'A',

778 typcategory = 'A',

1145 typdelim = ',',

779 typdelim = ',',

1146 typname = "_int2",

780 typname = "_int2",

1147 typelem = int2

781 typelem = int2

1148 }

782 }

1149

783

1150−array_int2Oid :: Oid

1151−array_int2Oid = Oid 1005

1152−{-# INLINE array_int2Oid #-}

1153−

1154array_int2vector :: TypeInfo

784array_int2vector :: TypeInfo

1155array_int2vector = Array {

785array_int2vector = Array {

1156− typoid = array_int2vectorOid,

786+ typoid = Oid 1006,

1157 typcategory = 'A',

787 typcategory = 'A',

1158 typdelim = ',',

788 typdelim = ',',

1159 typname = "_int2vector",

789 typname = "_int2vector",

1160 typelem = int2vector

790 typelem = int2vector

1161 }

791 }

1162

792

1163−array_int2vectorOid :: Oid

1164−array_int2vectorOid = Oid 1006

1165−{-# INLINE array_int2vectorOid #-}

1166−

1167array_int4 :: TypeInfo

793array_int4 :: TypeInfo

1168array_int4 = Array {

794array_int4 = Array {

1169− typoid = array_int4Oid,

795+ typoid = Oid 1007,

1170 typcategory = 'A',

796 typcategory = 'A',

1171 typdelim = ',',

797 typdelim = ',',

1172 typname = "_int4",

798 typname = "_int4",

1173 typelem = int4

799 typelem = int4

1174 }

800 }

1175

801

1176−array_int4Oid :: Oid

1177−array_int4Oid = Oid 1007

1178−{-# INLINE array_int4Oid #-}

1179−

1180array_regproc :: TypeInfo

802array_regproc :: TypeInfo

1181array_regproc = Array {

803array_regproc = Array {

1182− typoid = array_regprocOid,

804+ typoid = Oid 1008,

1183 typcategory = 'A',

805 typcategory = 'A',

1184 typdelim = ',',

806 typdelim = ',',

1185 typname = "_regproc",

807 typname = "_regproc",

1186 typelem = regproc

808 typelem = regproc

1187 }

809 }

1188

810

1189−array_regprocOid :: Oid

1190−array_regprocOid = Oid 1008

1191−{-# INLINE array_regprocOid #-}

1192−

1193array_text :: TypeInfo

811array_text :: TypeInfo

1194array_text = Array {

812array_text = Array {

1195− typoid = array_textOid,

813+ typoid = Oid 1009,

1196 typcategory = 'A',

814 typcategory = 'A',

1197 typdelim = ',',

815 typdelim = ',',

1198 typname = "_text",

816 typname = "_text",

1199 typelem = text

817 typelem = text

1200 }

818 }

1201

819

1202−array_textOid :: Oid

1203−array_textOid = Oid 1009

1204−{-# INLINE array_textOid #-}

1205−

1206array_tid :: TypeInfo

820array_tid :: TypeInfo

1207array_tid = Array {

821array_tid = Array {

1208− typoid = array_tidOid,

822+ typoid = Oid 1010,

1209 typcategory = 'A',

823 typcategory = 'A',

1210 typdelim = ',',

824 typdelim = ',',

1211 typname = "_tid",

825 typname = "_tid",

1212 typelem = tid

826 typelem = tid

1213 }

827 }

1214

828

1215−array_tidOid :: Oid

1216−array_tidOid = Oid 1010

1217−{-# INLINE array_tidOid #-}

1218−

1219array_xid :: TypeInfo

829array_xid :: TypeInfo

1220array_xid = Array {

830array_xid = Array {

1221− typoid = array_xidOid,

831+ typoid = Oid 1011,

1222 typcategory = 'A',

832 typcategory = 'A',

1223 typdelim = ',',

833 typdelim = ',',

1224 typname = "_xid",

834 typname = "_xid",

1225 typelem = xid

835 typelem = xid

1226 }

836 }

1227

837

1228−array_xidOid :: Oid

1229−array_xidOid = Oid 1011

1230−{-# INLINE array_xidOid #-}

1231−

1232array_cid :: TypeInfo

838array_cid :: TypeInfo

1233array_cid = Array {

839array_cid = Array {

1234− typoid = array_cidOid,

840+ typoid = Oid 1012,

1235 typcategory = 'A',

841 typcategory = 'A',

1236 typdelim = ',',

842 typdelim = ',',

1237 typname = "_cid",

843 typname = "_cid",

1238 typelem = cid

844 typelem = cid

1239 }

845 }

1240

846

1241−array_cidOid :: Oid

1242−array_cidOid = Oid 1012

1243−{-# INLINE array_cidOid #-}

1244−

1245array_oidvector :: TypeInfo

847array_oidvector :: TypeInfo

1246array_oidvector = Array {

848array_oidvector = Array {

1247− typoid = array_oidvectorOid,

849+ typoid = Oid 1013,

1248 typcategory = 'A',

850 typcategory = 'A',

1249 typdelim = ',',

851 typdelim = ',',

1250 typname = "_oidvector",

852 typname = "_oidvector",

1251 typelem = oidvector

853 typelem = oidvector

1252 }

854 }

1253

855

1254−array_oidvectorOid :: Oid

1255−array_oidvectorOid = Oid 1013

1256−{-# INLINE array_oidvectorOid #-}

1257−

1258array_bpchar :: TypeInfo

856array_bpchar :: TypeInfo

1259array_bpchar = Array {

857array_bpchar = Array {

1260− typoid = array_bpcharOid,

858+ typoid = Oid 1014,

1261 typcategory = 'A',

859 typcategory = 'A',

1262 typdelim = ',',

860 typdelim = ',',

1263 typname = "_bpchar",

861 typname = "_bpchar",

1264 typelem = bpchar

862 typelem = bpchar

1265 }

863 }

1266

864

1267−array_bpcharOid :: Oid

1268−array_bpcharOid = Oid 1014

1269−{-# INLINE array_bpcharOid #-}

1270−

1271array_varchar :: TypeInfo

865array_varchar :: TypeInfo

1272array_varchar = Array {

866array_varchar = Array {

1273− typoid = array_varcharOid,

867+ typoid = Oid 1015,

1274 typcategory = 'A',

868 typcategory = 'A',

1275 typdelim = ',',

869 typdelim = ',',

1276 typname = "_varchar",

870 typname = "_varchar",

1277 typelem = varchar

871 typelem = varchar

1278 }

872 }

1279

873

1280−array_varcharOid :: Oid

1281−array_varcharOid = Oid 1015

1282−{-# INLINE array_varcharOid #-}

1283−

1284array_int8 :: TypeInfo

874array_int8 :: TypeInfo

1285array_int8 = Array {

875array_int8 = Array {

1286− typoid = array_int8Oid,

876+ typoid = Oid 1016,

1287 typcategory = 'A',

877 typcategory = 'A',

1288 typdelim = ',',

878 typdelim = ',',

1289 typname = "_int8",

879 typname = "_int8",

1290 typelem = int8

880 typelem = int8

1291 }

881 }

1292

882

1293−array_int8Oid :: Oid

1294−array_int8Oid = Oid 1016

1295−{-# INLINE array_int8Oid #-}

1296−

1297array_point :: TypeInfo

883array_point :: TypeInfo

1298array_point = Array {

884array_point = Array {

1299− typoid = array_pointOid,

885+ typoid = Oid 1017,

1300 typcategory = 'A',

886 typcategory = 'A',

1301 typdelim = ',',

887 typdelim = ',',

1302 typname = "_point",

888 typname = "_point",

1303 typelem = point

889 typelem = point

1304 }

890 }

1305

891

1306−array_pointOid :: Oid

1307−array_pointOid = Oid 1017

1308−{-# INLINE array_pointOid #-}

1309−

1310array_lseg :: TypeInfo

892array_lseg :: TypeInfo

1311array_lseg = Array {

893array_lseg = Array {

1312− typoid = array_lsegOid,

894+ typoid = Oid 1018,

1313 typcategory = 'A',

895 typcategory = 'A',

1314 typdelim = ',',

896 typdelim = ',',

1315 typname = "_lseg",

897 typname = "_lseg",

1316 typelem = lseg

898 typelem = lseg

1317 }

899 }

1318

900

1319−array_lsegOid :: Oid

1320−array_lsegOid = Oid 1018

1321−{-# INLINE array_lsegOid #-}

1322−

1323array_path :: TypeInfo

901array_path :: TypeInfo

1324array_path = Array {

902array_path = Array {

1325− typoid = array_pathOid,

903+ typoid = Oid 1019,

1326 typcategory = 'A',

904 typcategory = 'A',

1327 typdelim = ',',

905 typdelim = ',',

1328 typname = "_path",

906 typname = "_path",

1329 typelem = path

907 typelem = path

1330 }

908 }

1331

909

1332−array_pathOid :: Oid

1333−array_pathOid = Oid 1019

1334−{-# INLINE array_pathOid #-}

1335−

1336array_box :: TypeInfo

910array_box :: TypeInfo

1337array_box = Array {

911array_box = Array {

1338− typoid = array_boxOid,

912+ typoid = Oid 1020,

1339 typcategory = 'A',

913 typcategory = 'A',

1340 typdelim = ';',

914 typdelim = ';',

1341 typname = "_box",

915 typname = "_box",

1342 typelem = box

916 typelem = box

1343 }

917 }

1344

918

1345−array_boxOid :: Oid

1346−array_boxOid = Oid 1020

1347−{-# INLINE array_boxOid #-}

1348−

1349array_float4 :: TypeInfo

919array_float4 :: TypeInfo

1350array_float4 = Array {

920array_float4 = Array {

1351− typoid = array_float4Oid,

921+ typoid = Oid 1021,

1352 typcategory = 'A',

922 typcategory = 'A',

1353 typdelim = ',',

923 typdelim = ',',

1354 typname = "_float4",

924 typname = "_float4",

1355 typelem = float4

925 typelem = float4

1356 }

926 }

1357

927

1358−array_float4Oid :: Oid

1359−array_float4Oid = Oid 1021

1360−{-# INLINE array_float4Oid #-}

1361−

1362array_float8 :: TypeInfo

928array_float8 :: TypeInfo

1363array_float8 = Array {

929array_float8 = Array {

1364− typoid = array_float8Oid,

930+ typoid = Oid 1022,

1365 typcategory = 'A',

931 typcategory = 'A',

1366 typdelim = ',',

932 typdelim = ',',

1367 typname = "_float8",

933 typname = "_float8",

1368 typelem = float8

934 typelem = float8

1369 }

935 }

1370

936

1371−array_float8Oid :: Oid

1372−array_float8Oid = Oid 1022

1373−{-# INLINE array_float8Oid #-}

1374−

1375array_polygon :: TypeInfo

937array_polygon :: TypeInfo

1376array_polygon = Array {

938array_polygon = Array {

1377− typoid = array_polygonOid,

939+ typoid = Oid 1027,

1378 typcategory = 'A',

940 typcategory = 'A',

1379 typdelim = ',',

941 typdelim = ',',

1380 typname = "_polygon",

942 typname = "_polygon",

1381 typelem = polygon

943 typelem = polygon

1382 }

944 }

1383

945

1384−array_polygonOid :: Oid

1385−array_polygonOid = Oid 1027

1386−{-# INLINE array_polygonOid #-}

1387−

1388array_oid :: TypeInfo

946array_oid :: TypeInfo

1389array_oid = Array {

947array_oid = Array {

1390− typoid = array_oidOid,

948+ typoid = Oid 1028,

1391 typcategory = 'A',

949 typcategory = 'A',

1392 typdelim = ',',

950 typdelim = ',',

1393 typname = "_oid",

951 typname = "_oid",

1394 typelem = oid

952 typelem = oid

1395 }

953 }

1396

954

1397−array_oidOid :: Oid

1398−array_oidOid = Oid 1028

1399−{-# INLINE array_oidOid #-}

1400−

1401array_macaddr :: TypeInfo

955array_macaddr :: TypeInfo

1402array_macaddr = Array {

956array_macaddr = Array {

1403− typoid = array_macaddrOid,

957+ typoid = Oid 1040,

1404 typcategory = 'A',

958 typcategory = 'A',

1405 typdelim = ',',

959 typdelim = ',',

1406 typname = "_macaddr",

960 typname = "_macaddr",

1407 typelem = macaddr

961 typelem = macaddr

1408 }

962 }

1409

963

1410−array_macaddrOid :: Oid

1411−array_macaddrOid = Oid 1040

1412−{-# INLINE array_macaddrOid #-}

1413−

1414array_inet :: TypeInfo

964array_inet :: TypeInfo

1415array_inet = Array {

965array_inet = Array {

1416− typoid = array_inetOid,

966+ typoid = Oid 1041,

1417 typcategory = 'A',

967 typcategory = 'A',

1418 typdelim = ',',

968 typdelim = ',',

1419 typname = "_inet",

969 typname = "_inet",

1420 typelem = inet

970 typelem = inet

1421 }

971 }

1422

972

1423−array_inetOid :: Oid

1424−array_inetOid = Oid 1041

1425−{-# INLINE array_inetOid #-}

1426−

1427array_timestamp :: TypeInfo

973array_timestamp :: TypeInfo

1428array_timestamp = Array {

974array_timestamp = Array {

1429− typoid = array_timestampOid,

975+ typoid = Oid 1115,

1430 typcategory = 'A',

976 typcategory = 'A',

1431 typdelim = ',',

977 typdelim = ',',

1432 typname = "_timestamp",

978 typname = "_timestamp",

1433 typelem = timestamp

979 typelem = timestamp

1434 }

980 }

1435

981

1436−array_timestampOid :: Oid

1437−array_timestampOid = Oid 1115

1438−{-# INLINE array_timestampOid #-}

1439−

1440array_date :: TypeInfo

982array_date :: TypeInfo

1441array_date = Array {

983array_date = Array {

1442− typoid = array_dateOid,

984+ typoid = Oid 1182,

1443 typcategory = 'A',

985 typcategory = 'A',

1444 typdelim = ',',

986 typdelim = ',',

1445 typname = "_date",

987 typname = "_date",

1446 typelem = date

988 typelem = date

1447 }

989 }

1448

990

1449−array_dateOid :: Oid

1450−array_dateOid = Oid 1182

1451−{-# INLINE array_dateOid #-}

1452−

1453array_time :: TypeInfo

991array_time :: TypeInfo

1454array_time = Array {

992array_time = Array {

1455− typoid = array_timeOid,

993+ typoid = Oid 1183,

1456 typcategory = 'A',

994 typcategory = 'A',

1457 typdelim = ',',

995 typdelim = ',',

1458 typname = "_time",

996 typname = "_time",

1459 typelem = time

997 typelem = time

1460 }

998 }

1461

999

1462−array_timeOid :: Oid

1463−array_timeOid = Oid 1183

1464−{-# INLINE array_timeOid #-}

1465−

1466array_timestamptz :: TypeInfo

1000array_timestamptz :: TypeInfo

1467array_timestamptz = Array {

1001array_timestamptz = Array {

1468− typoid = array_timestamptzOid,

1002+ typoid = Oid 1185,

1469 typcategory = 'A',

1003 typcategory = 'A',

1470 typdelim = ',',

1004 typdelim = ',',

1471 typname = "_timestamptz",

1005 typname = "_timestamptz",

1472 typelem = timestamptz

1006 typelem = timestamptz

1473 }

1007 }

1474

1008

1475−array_timestamptzOid :: Oid

1476−array_timestamptzOid = Oid 1185

1477−{-# INLINE array_timestamptzOid #-}

1478−

1479array_interval :: TypeInfo

1009array_interval :: TypeInfo

1480array_interval = Array {

1010array_interval = Array {

1481− typoid = array_intervalOid,

1011+ typoid = Oid 1187,

1482 typcategory = 'A',

1012 typcategory = 'A',

1483 typdelim = ',',

1013 typdelim = ',',

1484 typname = "_interval",

1014 typname = "_interval",

1485 typelem = interval

1015 typelem = interval

1486 }

1016 }

1487

1017

1488−array_intervalOid :: Oid

1489−array_intervalOid = Oid 1187

1490−{-# INLINE array_intervalOid #-}

1491−

1492array_numeric :: TypeInfo

1018array_numeric :: TypeInfo

1493array_numeric = Array {

1019array_numeric = Array {

1494− typoid = array_numericOid,

1020+ typoid = Oid 1231,

1495 typcategory = 'A',

1021 typcategory = 'A',

1496 typdelim = ',',

1022 typdelim = ',',

1497 typname = "_numeric",

1023 typname = "_numeric",

1498 typelem = numeric

1024 typelem = numeric

1499 }

1025 }

1500

1026

1501−array_numericOid :: Oid

1502−array_numericOid = Oid 1231

1503−{-# INLINE array_numericOid #-}

1504−

1505array_timetz :: TypeInfo

1027array_timetz :: TypeInfo

1506array_timetz = Array {

1028array_timetz = Array {

1507− typoid = array_timetzOid,

1029+ typoid = Oid 1270,

1508 typcategory = 'A',

1030 typcategory = 'A',

1509 typdelim = ',',

1031 typdelim = ',',

1510 typname = "_timetz",

1032 typname = "_timetz",

1511 typelem = timetz

1033 typelem = timetz

1512 }

1034 }

1513

1035

1514−array_timetzOid :: Oid

1515−array_timetzOid = Oid 1270

1516−{-# INLINE array_timetzOid #-}

1517−

1518array_bit :: TypeInfo

1036array_bit :: TypeInfo

1519array_bit = Array {

1037array_bit = Array {

1520− typoid = array_bitOid,

1038+ typoid = Oid 1561,

1521 typcategory = 'A',

1039 typcategory = 'A',

1522 typdelim = ',',

1040 typdelim = ',',

1523 typname = "_bit",

1041 typname = "_bit",

1524 typelem = bit

1042 typelem = bit

1525 }

1043 }

1526

1044

1527−array_bitOid :: Oid

1528−array_bitOid = Oid 1561

1529−{-# INLINE array_bitOid #-}

1530−

1531array_varbit :: TypeInfo

1045array_varbit :: TypeInfo

1532array_varbit = Array {

1046array_varbit = Array {

1533− typoid = array_varbitOid,

1047+ typoid = Oid 1563,

1534 typcategory = 'A',

1048 typcategory = 'A',

1535 typdelim = ',',

1049 typdelim = ',',

1536 typname = "_varbit",

1050 typname = "_varbit",

1537 typelem = varbit

1051 typelem = varbit

1538 }

1052 }

1539

1053

1540−array_varbitOid :: Oid

1541−array_varbitOid = Oid 1563

1542−{-# INLINE array_varbitOid #-}

1543−

1544array_refcursor :: TypeInfo

1054array_refcursor :: TypeInfo

1545array_refcursor = Array {

1055array_refcursor = Array {

1546− typoid = array_refcursorOid,

1056+ typoid = Oid 2201,

1547 typcategory = 'A',

1057 typcategory = 'A',

1548 typdelim = ',',

1058 typdelim = ',',

1549 typname = "_refcursor",

1059 typname = "_refcursor",

1550 typelem = refcursor

1060 typelem = refcursor

1551 }

1061 }

1552

1062

1553−array_refcursorOid :: Oid

1554−array_refcursorOid = Oid 2201

1555−{-# INLINE array_refcursorOid #-}

1556−

1557array_regprocedure :: TypeInfo

1063array_regprocedure :: TypeInfo

1558array_regprocedure = Array {

1064array_regprocedure = Array {

1559− typoid = array_regprocedureOid,

1065+ typoid = Oid 2207,

1560 typcategory = 'A',

1066 typcategory = 'A',

1561 typdelim = ',',

1067 typdelim = ',',

1562 typname = "_regprocedure",

1068 typname = "_regprocedure",

1563 typelem = regprocedure

1069 typelem = regprocedure

1564 }

1070 }

1565

1071

1566−array_regprocedureOid :: Oid

1567−array_regprocedureOid = Oid 2207

1568−{-# INLINE array_regprocedureOid #-}

1569−

1570array_regoper :: TypeInfo

1072array_regoper :: TypeInfo

1571array_regoper = Array {

1073array_regoper = Array {

1572− typoid = array_regoperOid,

1074+ typoid = Oid 2208,

1573 typcategory = 'A',

1075 typcategory = 'A',

1574 typdelim = ',',

1076 typdelim = ',',

1575 typname = "_regoper",

1077 typname = "_regoper",

1576 typelem = regoper

1078 typelem = regoper

1577 }

1079 }

1578

1080

1579−array_regoperOid :: Oid

1580−array_regoperOid = Oid 2208

1581−{-# INLINE array_regoperOid #-}

1582−

1583array_regoperator :: TypeInfo

1081array_regoperator :: TypeInfo

1584array_regoperator = Array {

1082array_regoperator = Array {

1585− typoid = array_regoperatorOid,

1083+ typoid = Oid 2209,

1586 typcategory = 'A',

1084 typcategory = 'A',

1587 typdelim = ',',

1085 typdelim = ',',

1588 typname = "_regoperator",

1086 typname = "_regoperator",

1589 typelem = regoperator

1087 typelem = regoperator

1590 }

1088 }

1591

1089

1592−array_regoperatorOid :: Oid

1593−array_regoperatorOid = Oid 2209

1594−{-# INLINE array_regoperatorOid #-}

1595−

1596array_regclass :: TypeInfo

1090array_regclass :: TypeInfo

1597array_regclass = Array {

1091array_regclass = Array {

1598− typoid = array_regclassOid,

1092+ typoid = Oid 2210,

1599 typcategory = 'A',

1093 typcategory = 'A',

1600 typdelim = ',',

1094 typdelim = ',',

1601 typname = "_regclass",

1095 typname = "_regclass",

1602 typelem = regclass

1096 typelem = regclass

1603 }

1097 }

1604

1098

1605−array_regclassOid :: Oid

1606−array_regclassOid = Oid 2210

1607−{-# INLINE array_regclassOid #-}

1608−

1609array_regtype :: TypeInfo

1099array_regtype :: TypeInfo

1610array_regtype = Array {

1100array_regtype = Array {

1611− typoid = array_regtypeOid,

1101+ typoid = Oid 2211,

1612 typcategory = 'A',

1102 typcategory = 'A',

1613 typdelim = ',',

1103 typdelim = ',',

1614 typname = "_regtype",

1104 typname = "_regtype",

1615 typelem = regtype

1105 typelem = regtype

1616 }

1106 }

1617

1107

1618−array_regtypeOid :: Oid

1619−array_regtypeOid = Oid 2211

1620−{-# INLINE array_regtypeOid #-}

1621−

1622array_uuid :: TypeInfo

1108array_uuid :: TypeInfo

1623array_uuid = Array {

1109array_uuid = Array {

1624− typoid = array_uuidOid,

1110+ typoid = Oid 2951,

1625 typcategory = 'A',

1111 typcategory = 'A',

1626 typdelim = ',',

1112 typdelim = ',',

1627 typname = "_uuid",

1113 typname = "_uuid",

1628 typelem = uuid

1114 typelem = uuid

1629 }

1115 }

1630

1116

1631−array_uuidOid :: Oid

1632−array_uuidOid = Oid 2951

1633−{-# INLINE array_uuidOid #-}

1634−

1635array_jsonb :: TypeInfo

1117array_jsonb :: TypeInfo

1636array_jsonb = Array {

1118array_jsonb = Array {

1637− typoid = array_jsonbOid,

1119+ typoid = Oid 3807,

1638 typcategory = 'A',

1120 typcategory = 'A',

1639 typdelim = ',',

1121 typdelim = ',',

1640 typname = "_jsonb",

1122 typname = "_jsonb",

1641 typelem = jsonb

1123 typelem = jsonb

1642 }

1124 }

1643

1125

1644−array_jsonbOid :: Oid

1645−array_jsonbOid = Oid 3807

1646−{-# INLINE array_jsonbOid #-}

1647−

1648int4range :: TypeInfo

1126int4range :: TypeInfo

1649int4range = Range {

1127int4range = Range {

1650− typoid = int4rangeOid,

1128+ typoid = Oid 3904,

1651 typcategory = 'R',

1129 typcategory = 'R',

1652 typdelim = ',',

1130 typdelim = ',',

1653 typname = "int4range",

1131 typname = "int4range",

1654 rngsubtype = int4

1132 rngsubtype = int4

1655 }

1133 }

1656

1134

1657−int4rangeOid :: Oid

1658−int4rangeOid = Oid 3904

1659−{-# INLINE int4rangeOid #-}

1660−

1661_int4range :: TypeInfo

1135_int4range :: TypeInfo

1662_int4range = Array {

1136_int4range = Array {

1663− typoid = _int4rangeOid,

1137+ typoid = Oid 3905,

1664 typcategory = 'A',

1138 typcategory = 'A',

1665 typdelim = ',',

1139 typdelim = ',',

1666 typname = "_int4range",

1140 typname = "_int4range",

1667 typelem = int4range

1141 typelem = int4range

1668 }

1142 }

1669

1143

1670−_int4rangeOid :: Oid

1671−_int4rangeOid = Oid 3905

1672−{-# INLINE _int4rangeOid #-}

1673−

1674numrange :: TypeInfo

1144numrange :: TypeInfo

1675numrange = Range {

1145numrange = Range {

1676− typoid = numrangeOid,

1146+ typoid = Oid 3906,

1677 typcategory = 'R',

1147 typcategory = 'R',

1678 typdelim = ',',

1148 typdelim = ',',

1679 typname = "numrange",

1149 typname = "numrange",

1680 rngsubtype = numeric

1150 rngsubtype = numeric

1681 }

1151 }

1682

1152

1683−numrangeOid :: Oid

1684−numrangeOid = Oid 3906

1685−{-# INLINE numrangeOid #-}

1686−

1687_numrange :: TypeInfo

1153_numrange :: TypeInfo

1688_numrange = Array {

1154_numrange = Array {

1689− typoid = _numrangeOid,

1155+ typoid = Oid 3907,

1690 typcategory = 'A',

1156 typcategory = 'A',

1691 typdelim = ',',

1157 typdelim = ',',

1692 typname = "_numrange",

1158 typname = "_numrange",

1693 typelem = numrange

1159 typelem = numrange

1694 }

1160 }

1695

1161

1696−_numrangeOid :: Oid

1697−_numrangeOid = Oid 3907

1698−{-# INLINE _numrangeOid #-}

1699−

1700tsrange :: TypeInfo

1162tsrange :: TypeInfo

1701tsrange = Range {

1163tsrange = Range {

1702− typoid = tsrangeOid,

1164+ typoid = Oid 3908,

1703 typcategory = 'R',

1165 typcategory = 'R',

1704 typdelim = ',',

1166 typdelim = ',',

1705 typname = "tsrange",

1167 typname = "tsrange",

1706 rngsubtype = timestamp

1168 rngsubtype = timestamp

1707 }

1169 }

1708

1170

1709−tsrangeOid :: Oid

1710−tsrangeOid = Oid 3908

1711−{-# INLINE tsrangeOid #-}

1712−

1713_tsrange :: TypeInfo

1171_tsrange :: TypeInfo

1714_tsrange = Array {

1172_tsrange = Array {

1715− typoid = _tsrangeOid,

1173+ typoid = Oid 3909,

1716 typcategory = 'A',

1174 typcategory = 'A',

1717 typdelim = ',',

1175 typdelim = ',',

1718 typname = "_tsrange",

1176 typname = "_tsrange",

1719 typelem = tsrange

1177 typelem = tsrange

1720 }

1178 }

1721

1179

1722−_tsrangeOid :: Oid

1723−_tsrangeOid = Oid 3909

1724−{-# INLINE _tsrangeOid #-}

1725−

1726tstzrange :: TypeInfo

1180tstzrange :: TypeInfo

1727tstzrange = Range {

1181tstzrange = Range {

1728− typoid = tstzrangeOid,

1182+ typoid = Oid 3910,

1729 typcategory = 'R',

1183 typcategory = 'R',

1730 typdelim = ',',

1184 typdelim = ',',

1731 typname = "tstzrange",

1185 typname = "tstzrange",

1732 rngsubtype = timestamptz

1186 rngsubtype = timestamptz

1733 }

1187 }

1734

1188

1735−tstzrangeOid :: Oid

1736−tstzrangeOid = Oid 3910

1737−{-# INLINE tstzrangeOid #-}

1738−

1739_tstzrange :: TypeInfo

1189_tstzrange :: TypeInfo

1740_tstzrange = Array {

1190_tstzrange = Array {

1741− typoid = _tstzrangeOid,

1191+ typoid = Oid 3911,

1742 typcategory = 'A',

1192 typcategory = 'A',

1743 typdelim = ',',

1193 typdelim = ',',

1744 typname = "_tstzrange",

1194 typname = "_tstzrange",

1745 typelem = tstzrange

1195 typelem = tstzrange

1746 }

1196 }

1747

1197

1748−_tstzrangeOid :: Oid

1749−_tstzrangeOid = Oid 3911

1750−{-# INLINE _tstzrangeOid #-}

1751−

1752daterange :: TypeInfo

1198daterange :: TypeInfo

1753daterange = Range {

1199daterange = Range {

1754− typoid = daterangeOid,

1200+ typoid = Oid 3912,

1755 typcategory = 'R',

1201 typcategory = 'R',

1756 typdelim = ',',

1202 typdelim = ',',

1757 typname = "daterange",

1203 typname = "daterange",

1758 rngsubtype = date

1204 rngsubtype = date

1759 }

1205 }

1760

1206

1761−daterangeOid :: Oid

1762−daterangeOid = Oid 3912

1763−{-# INLINE daterangeOid #-}

1764−

1765_daterange :: TypeInfo

1207_daterange :: TypeInfo

1766_daterange = Array {

1208_daterange = Array {

1767− typoid = _daterangeOid,

1209+ typoid = Oid 3913,

1768 typcategory = 'A',

1210 typcategory = 'A',

1769 typdelim = ',',

1211 typdelim = ',',

1770 typname = "_daterange",

1212 typname = "_daterange",

1771 typelem = daterange

1213 typelem = daterange

1772 }

1214 }

1773

1215

1774−_daterangeOid :: Oid

1775−_daterangeOid = Oid 3913

1776−{-# INLINE _daterangeOid #-}

1777−

1778int8range :: TypeInfo

1216int8range :: TypeInfo

1779int8range = Range {

1217int8range = Range {

1780− typoid = int8rangeOid,

1218+ typoid = Oid 3926,

1781 typcategory = 'R',

1219 typcategory = 'R',

1782 typdelim = ',',

1220 typdelim = ',',

1783 typname = "int8range",

1221 typname = "int8range",

1784 rngsubtype = int8

1222 rngsubtype = int8

1785 }

1223 }

1786

1224

1787−int8rangeOid :: Oid

1788−int8rangeOid = Oid 3926

1789−{-# INLINE int8rangeOid #-}

1790−

1791_int8range :: TypeInfo

1225_int8range :: TypeInfo

1792_int8range = Array {

1226_int8range = Array {

1793− typoid = _int8rangeOid,

1227+ typoid = Oid 3927,

1794 typcategory = 'A',

1228 typcategory = 'A',

1795 typdelim = ',',

1229 typdelim = ',',

1796 typname = "_int8range",

1230 typname = "_int8range",

1797 typelem = int8range

1231 typelem = int8range

1798 }

1232 }

1799−

1800−_int8rangeOid :: Oid

1801−_int8rangeOid = Oid 3927

1802−{-# INLINE _int8rangeOid #-}

src/Database/PostgreSQL/Simple/Types.hs+30−54

@@ -1,4 +1,4 @@

1−{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}

1+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}

3------------------------------------------------------------------------------

4-- |

@@ -33,16 +33,13 @@ module Database.PostgreSQL.Simple.Types

33import Control.Arrow (first)

34import Data.ByteString (ByteString)

35import Data.Hashable (Hashable(hashWithSalt))

36−import Data.Foldable (toList)

37import Data.Monoid (Monoid(..))

36import Data.Monoid (Monoid(..))

38−import Data.Semigroup

39import Data.String (IsString(..))

37import Data.String (IsString(..))

40import Data.Typeable (Typeable)

38import Data.Typeable (Typeable)

41import Data.ByteString.Builder ( stringUtf8 )

39import Data.ByteString.Builder ( stringUtf8 )

42import qualified Data.ByteString as B

40import qualified Data.ByteString as B

43import Data.Text (Text)

41import Data.Text (Text)

44import qualified Data.Text as T

42import qualified Data.Text as T

45−import Data.Tuple.Only (Only(..))

46import Database.PostgreSQL.LibPQ (Oid(..))

43import Database.PostgreSQL.LibPQ (Oid(..))

47import Database.PostgreSQL.Simple.Compat (toByteString)

44import Database.PostgreSQL.Simple.Compat (toByteString)

@@ -50,6 +47,10 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

50data Null = Null

47data Null = Null

51 deriving (Read, Show, Typeable)

48 deriving (Read, Show, Typeable)

50+instance Eq Null where

51+ _ == _ = False

52+ _ /= _ = False

53+

53-- | A placeholder for the PostgreSQL @DEFAULT@ value.

54-- | A placeholder for the PostgreSQL @DEFAULT@ value.

54data Default = Default

55data Default = Default

55 deriving (Read, Show, Typeable)

56 deriving (Read, Show, Typeable)

@@ -86,59 +87,36 @@ instance Read Query where

86instance IsString Query where

87instance IsString Query where

87 fromString = Query . toByteString . stringUtf8

88 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−

94instance Monoid Query where

90instance Monoid Query where

95 mempty = Query B.empty

91 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))

97−-- | Wrap a list of values for use in an @IN@ clause. Replaces a

96+-- | A single-value \"collection\".

98−-- single \"@?@\" character with a parenthesized list of rendered

99−-- values.

100−--

101−-- Example:

102−--

103−-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))

104--

97--

105−-- Note that @In []@ expands to @(null)@, which works as expected in

98+-- This is useful if you need to supply a single parameter to a SQL

106−-- the query above, but evaluates to the logical null value on every

99+-- query, or extract a single column from a SQL result.

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--

100--

111−-- Since postgresql doesn't seem to provide a syntax for actually specifying

101+-- Parameter example:

112−-- an empty list, which could solve this completely, there are two

113−-- workarounds particularly worth mentioning, namely:

114--

102--

115−-- 1. Use postgresql-simple's 'Values' type instead, which can handle the

103+-- @query c \"select x from scores where x > ?\" ('Only' (42::Int))@

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--

104--

121−-- > query c "select * from whatever where id not in ?"

105+-- Result example:

122−-- > (Only (Values ["int4"] [] :: Values (Only Int)))

123--

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

114+-- single \"@?@\" character with a parenthesized list of rendered

115+-- values.

124--

116--

125−-- 2. Use sql's @COALESCE@ operator to turn a logical @null@ into the correct

117+-- Example:

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--

118--

135−-- Note that at as of PostgreSQL 9.4, the query planner cannot see inside

119+-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))

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−

142newtype In a = In a

120newtype In a = In a

143 deriving (Eq, Ord, Read, Show, Typeable, Functor)

121 deriving (Eq, Ord, Read, Show, Typeable, Functor)

144

122

@@ -201,9 +179,8 @@ infixr 3 :.

201newtype Savepoint = Savepoint Query

179newtype Savepoint = Savepoint Query

202 deriving (Eq, Ord, Show, Read, Typeable)

180 deriving (Eq, Ord, Show, Read, Typeable)

203

181

204−-- | Represents a @VALUES@ table literal, usable as an alternative to

182+-- | Represents a @VALUES@ table literal, usable as an alternative

205−-- 'Database.PostgreSQL.Simple.executeMany' and

206−-- 'Database.PostgreSQL.Simple.returning'. The main advantage is that

183+-- to @executeMany@ and @returning@. The main advantage is that

207-- you can parametrize more than just a single @VALUES@ expression.

184-- you can parametrize more than just a single @VALUES@ expression.

208-- For example, here's a query to insert a thing into one table

185-- For example, here's a query to insert a thing into one table

209-- and some attributes of that thing into another, returning the

186-- and some attributes of that thing into another, returning the

@@ -216,7 +193,7 @@ newtype Savepoint = Savepoint Query

216-- > ), new_attributes AS (

193-- > ), new_attributes AS (

217-- > INSERT INTO thing_attributes

194-- > INSERT INTO thing_attributes

218-- > SELECT new_thing.id, attrs.*

195-- > SELECT new_thing.id, attrs.*

219−-- > FROM new_thing JOIN ? attrs ON TRUE

196+-- > FROM new_thing JOIN ? attrs

220-- > ) SELECT * FROM new_thing

197-- > ) SELECT * FROM new_thing

221-- > |] ("foo", Values [ "int4", "text" ]

198-- > |] ("foo", Values [ "int4", "text" ]

222-- > [ ( 1 , "hello" )

199-- > [ ( 1 , "hello" )

@@ -242,8 +219,7 @@ newtype Savepoint = Savepoint Query

242-- is turned into a properly quoted identifier, the type name is case

219-- is turned into a properly quoted identifier, the type name is case

243-- sensitive and must be as it appears in the @pg_type@ table. Thus,

220-- sensitive and must be as it appears in the @pg_type@ table. Thus,

244-- you must write @timestamptz@ instead of @timestamp with time zone@,

221-- you must write @timestamptz@ instead of @timestamp with time zone@,

245−-- @int4@ instead of @integer@ or @serial@, @_int8@ instead of @bigint[]@,

222+-- @int4@ instead of @integer@, @_int8@ instead of @bigint[]@, etcetera.

246−-- etcetera.

247--

223--

248-- You may omit the type names, however, if you do so the list

224-- You may omit the type names, however, if you do so the list

249-- of values must be non-empty, and postgresql must be able to infer

225-- of values must be non-empty, and postgresql must be able to infer

@@ -252,7 +228,7 @@ newtype Savepoint = Savepoint Query

252-- without issuing the query. In the second case, the postgres server

228-- without issuing the query. In the second case, the postgres server

253-- will return an error which will be turned into a @SqlError@ exception.

229-- will return an error which will be turned into a @SqlError@ exception.

254--

230--

255−-- See <https://www.postgresql.org/docs/9.5/static/sql-values.html> for

231+-- See <http://www.postgresql.org/docs/9.3/static/sql-values.html> for

256-- more information.

232-- more information.

257data Values a = Values [QualifiedIdentifier] [a]

233data Values a = Values [QualifiedIdentifier] [a]

258 deriving (Eq, Ord, Show, Read, Typeable)

234 deriving (Eq, Ord, Show, Read, Typeable)

src/Database/PostgreSQL/Simple/Vector.hsdeleted−45

@@ -1,45 +0,0 @@

1−-- | 'query' variants returning 'V.Vector'.

2−module Database.PostgreSQL.Simple.Vector where

3−

4−import Database.PostgreSQL.Simple (Connection, formatQuery, formatMany)

5−import Database.PostgreSQL.Simple.FromRow (FromRow(..))

6−import Database.PostgreSQL.Simple.ToRow (ToRow(..))

7−import Database.PostgreSQL.Simple.Internal (RowParser, exec)

8−import Database.PostgreSQL.Simple.Internal.PQResultUtils

9−import Database.PostgreSQL.Simple.Types ( Query (..) )

10−

11−import qualified Data.Vector as V

12−

13−-- | Perform a @SELECT@ or other SQL query that is expected to return

14−-- results. All results are retrieved and converted before this

15−-- function returns.

16−query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO (V.Vector r)

17−query = queryWith fromRow

18−

19−-- | A version of 'query' that does not perform query substitution.

20−query_ :: (FromRow r) => Connection -> Query -> IO (V.Vector r)

21−query_ = queryWith_ fromRow

22−

23−-- | A version of 'query' taking parser as argument

24−queryWith :: ToRow q => RowParser r -> Connection -> Query -> q -> IO (V.Vector r)

25−queryWith parser conn template qs = do

26− result <- exec conn =<< formatQuery conn template qs

27− finishQueryWithV parser conn template result

28−

29−-- | A version of 'query_' taking parser as argument

30−queryWith_ :: RowParser r -> Connection -> Query -> IO (V.Vector r)

31−queryWith_ parser conn q@(Query que) = do

32− result <- exec conn que

33− finishQueryWithV parser conn q result

34−

35−-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL

36−-- query that accepts multi-row input and is expected to return results.

37−returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO (V.Vector r)

38−returning = returningWith fromRow

39−

40−-- | A version of 'returning' taking parser as argument

41−returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO (V.Vector r)

42−returningWith _ _ _ [] = return V.empty

43−returningWith parser conn q qs = do

44− result <- exec conn =<< formatMany conn q qs

45− finishQueryWithV parser conn q result

src/Database/PostgreSQL/Simple/Vector/Unboxed.hsdeleted−44

@@ -1,44 +0,0 @@

1−module Database.PostgreSQL.Simple.Vector.Unboxed where

2−

3−import Database.PostgreSQL.Simple (Connection, formatQuery, formatMany)

4−import Database.PostgreSQL.Simple.FromRow (FromRow(..))

5−import Database.PostgreSQL.Simple.ToRow (ToRow(..))

6−import Database.PostgreSQL.Simple.Internal (RowParser, exec)

7−import Database.PostgreSQL.Simple.Internal.PQResultUtils

8−import Database.PostgreSQL.Simple.Types ( Query (..) )

9−

10−import qualified Data.Vector.Unboxed as VU

11−

12−-- | Perform a @SELECT@ or other SQL query that is expected to return

13−-- results. All results are retrieved and converted before this

14−-- function returns.

15−query :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> q -> IO (VU.Vector r)

16−query = queryWith fromRow

17−

18−-- | A version of 'query' that does not perform query substitution.

19−query_ :: (FromRow r, VU.Unbox r) => Connection -> Query -> IO (VU.Vector r)

20−query_ = queryWith_ fromRow

21−

22−-- | A version of 'query' taking parser as argument

23−queryWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> q -> IO (VU.Vector r)

24−queryWith parser conn template qs = do

25− result <- exec conn =<< formatQuery conn template qs

26− finishQueryWithVU parser conn template result

27−

28−-- | A version of 'query_' taking parser as argument

29−queryWith_ :: VU.Unbox r => RowParser r -> Connection -> Query -> IO (VU.Vector r)

30−queryWith_ parser conn q@(Query que) = do

31− result <- exec conn que

32− finishQueryWithVU parser conn q result

33−

34−-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL

35−-- query that accepts multi-row input and is expected to return results.

36−returning :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> [q] -> IO (VU.Vector r)

37−returning = returningWith fromRow

38−

39−-- | A version of 'returning' taking parser as argument

40−returningWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> [q] -> IO (VU.Vector r)

41−returningWith _ _ _ [] = return VU.empty

42−returningWith parser conn q qs = do

43− result <- exec conn =<< formatMany conn q qs

44− finishQueryWithVU parser conn q result

test/Common.hs+2−2

@@ -1,6 +1,6 @@

1module Common (

2 module Database.PostgreSQL.Simple,

3− module Test.Tasty.HUnit,

3+ module Test.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.Tasty.HUnit

11+import Test.HUnit

13import qualified Crypto.Hash.MD5 as MD5

14import qualified Data.ByteString.Base16 as Base16

test/Exception.hsdeleted−70

@@ -1,70 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−

5−module Exception (testExceptions) where

6−

7−import Database.PostgreSQL.Simple

8−import Test.Tasty.HUnit (Assertion, assertBool)

9−import Common (TestEnv)

10−import Control.Exception (Exception (..), SomeException)

11−import Data.Maybe (isJust)

12−import Data.Either (isLeft)

13−import Control.Exception (throwIO, try)

14−

15−testExceptions :: TestEnv -> Assertion

16−testExceptions _ = do

17− let sqlError = SqlError

18− { sqlState = ""

19− , sqlExecStatus = FatalError

20− , sqlErrorMsg = ""

21− , sqlErrorDetail = ""

22− , sqlErrorHint = ""

23− }

24− let sqlEx :: SomeException = toException sqlError

25− assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)

26− assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)

27− eSqlError :: Either SqlError () <- try $ throwIO sqlEx

28− assertBool "Can catch SqlError" $ isLeft eSqlError

29− eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx

30− assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx

31−

32− let formatError = FormatError

33− { fmtMessage = ""

34− , fmtQuery = ""

35− , fmtParams = []

36− }

37− let formatEx :: SomeException = toException formatError

38− assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)

39− assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)

40− eFormatError :: Either FormatError () <- try $ throwIO formatEx

41− assertBool "Can catch FormatError" $ isLeft eFormatError

42− eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx

43− assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx

44−

45− let queryError = QueryError

46− { qeMessage = ""

47− , qeQuery = ""

48− }

49− let queryEx :: SomeException = toException queryError

50− assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)

51− assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)

52− eQueryError :: Either QueryError () <- try $ throwIO queryEx

53− assertBool "Can catch QueryError" $ isLeft eQueryError

54− eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx

55− assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx

56−

57− let resultError = Incompatible

58− { errSQLType = ""

59− , errSQLTableOid = Nothing

60− , errSQLField = ""

61− , errHaskellType = ""

62− , errMessage = ""

63− }

64− let resultEx :: SomeException = toException resultError

65− assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)

66− assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)

67− eResultEx :: Either ResultError () <- try $ throwIO resultEx

68− assertBool "Can catch ResultError" $ isLeft eResultEx

69− eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx

70− assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx

test/Inspection.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE TemplateHaskell #-}

3−{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-module-prefixes -dsuppress-type-signatures #-}

4−-- {-# OPTIONS_GHC -dsuppress-uniques #-}

5−{-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin #-}

6−module Main where

7−

8−import Test.Inspection

9−import Test.Tasty

10−import Test.Tasty.HUnit

11−

12−import qualified Database.PostgreSQL.LibPQ as PQ

13−import Database.PostgreSQL.Simple.FromField

14−import Database.PostgreSQL.Simple.TypeInfo as TI

15−import Database.PostgreSQL.Simple.TypeInfo.Macro

16−import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI

17−

18−-------------------------------------------------------------------------------

19−-- Inspection tests

20−-------------------------------------------------------------------------------

21−

22−-- # doesn't work :(

23−#define TH_MKCOMPATS3(a,b,c) $(mkCompats [TI.a,TI.b,TI.c])

24−#define IN_MKCOMPATS3(a,b,c) (eq TI.a \/ eq TI.b \/ eq TI.c)

25−

26−#define TH_INLINETYPOID(n) eq $(inlineTypoid TI.n)

27−#define IN_INLINETYPOID(n) eq TI.n

28−

29−-- eta-expansion is required

30−lhs01, rhs01 :: PQ.Oid -> Bool

31−lhs01 = TH_MKCOMPATS3(name,text,char)

32−rhs01 = IN_MKCOMPATS3(nameOid,textOid,charOid)

33−

34−lhs02, rhs02 :: PQ.Oid -> Bool

35−lhs02 = TH_INLINETYPOID(name)

36−rhs02 = IN_INLINETYPOID(nameOid)

37−

38−eq :: PQ.Oid -> PQ.Oid -> Bool

39−eq = (==)

40−{-# INLINE eq #-}

41−

42−infixr 2 \/

43−(\/) :: (PQ.Oid -> Bool)

44− -> (PQ.Oid -> Bool)

45− -> (PQ.Oid -> Bool)

46−f \/ g = \x -> f x || g x

47−{-# INLINE (\/) #-}

48−

49−inspectionTests :: TestTree

50−inspectionTests = testGroup "inspection"

51− [ testCase "mkCompats" $

52− assertSuccess $(inspectTest $ 'lhs01 === 'rhs01)

53−

54− -- byteaOid isn't inlined?

55− , testCase "inlineTypoid" $

56−#if __GLASGOW_HASKELL__ >= 808

57− assertSuccess

58−#else

59− assertFailure'

60−#endif

61− $(inspectTest $ 'lhs02 ==- 'rhs02)

62− ]

63−

64−assertSuccess :: Result -> IO ()

65−assertSuccess (Success _) = return ()

66−assertSuccess (Failure err) = assertFailure err

67−

68−assertFailure' :: Result -> IO ()

69−assertFailure' (Success err) = assertFailure err

70−assertFailure' (Failure _) = return ()

71−

72−-------------------------------------------------------------------------------

73−-- Main

74−-------------------------------------------------------------------------------

75−

76−main :: IO ()

77−main = defaultMain $ testGroup "tests"

78− [ inspectionTests

79− ]

test/Interval.hsdeleted−176

@@ -1,176 +0,0 @@

1−{-# LANGUAGE QuasiQuotes #-}

2−

3−{-

4−

5−Testing strategies:

6−

7−fromString . toString == id ** Todo?

8−

9−toString . fromString == almost id ** Todo?

10−

11−postgresql -> haskell -> postgresql * Done

12−

13−haskell -> postgresql -> haskell ** Todo?

14−

15−But still, what we really want to establish is that the two values

16−correspond; for example, a conversion that consistently added hour

17−when printed to a string and subtracted an hour when parsed from string

18−would still pass these tests.

19−

20−

21−Right now, we are checking that 1400+ timestamps in the range of 1860 to

22−2060 round trip from postgresql to haskell and back in 5 different timezones.

23−In addition to UTC, the four timezones were selected so that 2 have a positive

24−offset, and 2 have a negative offset, and that 2 have an offset of a

25−whole number of hours, while the other two do not.

26−

27−It may be worth adding a few more timezones to ensure better test coverage.

28−

29−We are checking a handful of selected timestamps to ensure we hit

30−various corner-cases in the code, in addition to 1400 timestamps randomly

31−generated with granularity of seconds down to microseconds in powers of ten.

32−

33−-}

34−

35−module Interval (testInterval) where

36−

37−import Common

38−import Control.Monad(forM_, replicateM_)

39−import Data.Time.Compat

40−import Data.Time.LocalTime.Compat (CalendarDiffTime(..))

41−import Data.ByteString(ByteString)

42−import Database.PostgreSQL.Simple.SqlQQ

43−

44−data IntervalTestCase = IntervalTestCase

45− { label :: String

46− , inputMonths :: Integer

47− , inputSeconds :: NominalDiffTime

48− , asText :: String

49− }

50− deriving (Eq, Show)

51−

52−testInterval :: TestEnv -> Assertion

53−testInterval env@TestEnv{..} = do

54−

55− initializeTable env

56−

57− let milliseconds = 0.001

58− seconds = 1

59− minutes = 60 * seconds

60− hours = 60 * minutes

61− days = 24 * hours

62− weeks = 7 * days

63− months = 1

64− years = 12 * months

65−

66− mapM (checkRoundTrip env)

67− [ IntervalTestCase

68− { label = "zero"

69− , inputMonths = 0

70− , inputSeconds = 0

71− , asText = "PT0"

72− }

73− , IntervalTestCase

74− { label = "1 year"

75− , inputMonths = 1 * years

76− , inputSeconds = 0

77− , asText = "P1Y"

78− }

79− , IntervalTestCase

80− { label = "2 months"

81− , inputMonths = 2 * months

82− , inputSeconds = 0

83− , asText = "P2M"

84− }

85− , IntervalTestCase

86− { label = "3 weeks"

87− , inputMonths = 0

88− , inputSeconds = 3 * weeks

89− , asText = "P3W"

90− }

91− , IntervalTestCase

92− { label = "4 days"

93− , inputMonths = 0

94− , inputSeconds = 4 * days

95− , asText = "P4D"

96− }

97− , IntervalTestCase

98− { label = "5 hours"

99− , inputMonths = 0

100− , inputSeconds = 5 * hours

101− , asText = "PT5H"

102− }

103− , IntervalTestCase

104− { label = "6 minutes"

105− , inputMonths = 0

106− , inputSeconds = 6 * minutes

107− , asText = "PT6M"

108− }

109− , IntervalTestCase

110− { label = "7 seconds"

111− , inputMonths = 0

112− , inputSeconds = 7 * seconds

113− , asText = "PT7S"

114− }

115− , IntervalTestCase

116− { label = "8 milliseconds"

117− , inputMonths = 0

118− , inputSeconds = 8 * milliseconds

119− , asText = "PT0.008S"

120− }

121− , IntervalTestCase

122− { label = "combination of intervals (day-size or bigger)"

123− , inputMonths = 2 * years + 4 * months

124− , inputSeconds = 3 * weeks + 5 * days

125− , asText = "P2Y4M3W5D"

126− }

127− , IntervalTestCase

128− { label = "combination of intervals (smaller than day-size)"

129− , inputMonths = 0

130− , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

131− , asText = "PT18H56M23.563S"

132− }

133− , IntervalTestCase

134− { label = "full combination of intervals"

135− , inputMonths = 2 * years + 4 * months

136− , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

137− , asText = "P2Y4M3W5DT18H56M23.563S"

138− }

139− ]

140−

141− return ()

142−

143−initializeTable :: TestEnv -> IO ()

144−initializeTable TestEnv{..} = withTransaction conn $ do

145− execute_ conn

146− [sql| CREATE TEMPORARY TABLE testinterval

147− ( id serial, sample interval, PRIMARY KEY(id) ) |]

148−

149− return ()

150−

151−checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()

152−checkRoundTrip TestEnv{..} IntervalTestCase{..} = do

153−

154− let input = CalendarDiffTime

155− { ctMonths = inputMonths

156− , ctTime = inputSeconds

157− }

158−

159− [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|

160− INSERT INTO testinterval (sample)

161− VALUES (?)

162− RETURNING id, sample

163− |] (Only input)

164−

165− assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $

166− output == input

167−

168− [(Only isExpectedIso)] <- query conn [sql|

169− SELECT sample = (?)::interval

170− FROM testinterval

171− WHERE id = ?

172− |] (asText, returnedId)

173−

174− assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")

175− isExpectedIso

176−

test/Main.hs+59−343

@@ -1,95 +1,53 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

4{-# LANGUAGE DoAndIfThenElse #-}

2{-# LANGUAGE DoAndIfThenElse #-}

5{-# LANGUAGE ScopedTypeVariables #-}

3{-# LANGUAGE ScopedTypeVariables #-}

6−#if __GLASGOW_HASKELL__ >= 806

7−{-# LANGUAGE DerivingStrategies #-}

8−{-# LANGUAGE DerivingVia #-}

9−{-# LANGUAGE DeriveAnyClass #-}

10−#endif

11−module Main (main) where

12−

13import Common

4import Common

14−import Database.PostgreSQL.Simple.Copy

15−import Database.PostgreSQL.Simple.ToField (ToField)

16import Database.PostgreSQL.Simple.FromField (FromField)

5import Database.PostgreSQL.Simple.FromField (FromField)

6+import Database.PostgreSQL.Simple.Types(Query(..),Values(..))

17import Database.PostgreSQL.Simple.HStore

7import Database.PostgreSQL.Simple.HStore

18−import Database.PostgreSQL.Simple.Newtypes

8+import Database.PostgreSQL.Simple.Copy

19−import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)

20−import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))

21import qualified Database.PostgreSQL.Simple.Transaction as ST

9import qualified Database.PostgreSQL.Simple.Transaction as ST

22−

23import Control.Applicative

10import Control.Applicative

24import Control.Exception as E

11import Control.Exception as E

25import Control.Monad

12import Control.Monad

26−import Data.Char

13+import Data.ByteString (ByteString)

27−import Data.Foldable (toList)

28−import Data.List (concat, sort)

29import Data.IORef

14import Data.IORef

30−import Data.Monoid ((<>))

31−import Data.String (fromString)

32import Data.Typeable

15import Data.Typeable

33−import GHC.Generics (Generic)

34−

35−import Data.Aeson

36−import Data.ByteString (ByteString)

37import qualified Data.ByteString as B

16import 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

42import Data.Map (Map)

17import Data.Map (Map)

18+import Data.List (sort)

43import qualified Data.Map as Map

19import qualified Data.Map as Map

44import Data.Text(Text)

20import Data.Text(Text)

45import qualified Data.Text.Encoding as T

21import qualified Data.Text.Encoding as T

22+import System.Exit (exitFailure)

23+import System.IO

46import qualified Data.Vector as V

24import qualified Data.Vector as V

47−import System.FilePath

25+import Data.Aeson

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

54import Notify

27import Notify

55import Serializable

28import Serializable

56import Time

29import Time

57−import Interval

30+

58−import Exception (testExceptions)

59−

60−tests :: TestEnv -> TestTree

31+tests :: [TestEnv -> Test]

61−tests env = testGroup "tests"

32+tests =

62− $ map ($ env)

63− [ testBytea

33+ [ TestLabel "Bytea" . testBytea

64− , testCase "ExecuteMany" . testExecuteMany

34+ , TestLabel "ExecuteMany" . testExecuteMany

65− , testCase "Fold" . testFold

35+ , TestLabel "Fold" . testFold

66− , testCase "Notify" . testNotify

36+ , TestLabel "Notify" . testNotify

67− , testCase "Serializable" . testSerializable

37+ , TestLabel "Serializable" . testSerializable

68− , testCase "Time" . testTime

38+ , TestLabel "Time" . testTime

69− , testCase "Interval" . testInterval

70− , testCase "Array" . testArray

39+ , TestLabel "Array" . testArray

71− , testCase "Array of nullables" . testNullableArray

72− , testCase "HStore" . testHStore

40+ , TestLabel "HStore" . testHStore

73− , testCase "citext" . testCIText

74− , testCase "JSON" . testJSON

41+ , TestLabel "JSON" . testJSON

75− , testCase "Aeson newtype" . testAeson

76− , testCase "DerivingVia" . testDerivingVia

77− , testCase "Question mark escape" . testQM

78− , testCase "Savepoint" . testSavepoint

42+ , TestLabel "Savepoint" . testSavepoint

79− , testCase "Unicode" . testUnicode

43+ , TestLabel "Unicode" . testUnicode

80− , testCase "Values" . testValues

44+ , TestLabel "Values" . testValues

81− , testCase "Copy" . testCopy

45+ , TestLabel "Copy" . testCopy

82− , testCopyFailures

83− , testCase "Double" . testDouble

46+ , TestLabel "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

89 ]

47 ]

91−testBytea :: TestEnv -> TestTree

49+testBytea :: TestEnv -> Test

92−testBytea TestEnv{..} = testGroup "Bytea"

50+testBytea TestEnv{..} = TestList

93 [ testStr "empty" []

51 [ testStr "empty" []

94 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

52 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)

95 , testStr "ascending" [0..255]

53 , testStr "ascending" [0..255]

@@ -98,7 +56,7 @@ testBytea TestEnv{..} = testGroup "Bytea"

98 , testStr "descending, doubled up" $ doubleUp [255,254..0]

56 , testStr "descending, doubled up" $ doubleUp [255,254..0]

99 ]

57 ]

100 where

58 where

101− testStr label bytes = testCase label $ do

59+ testStr label bytes = TestLabel label $ TestCase $ do

102 let bs = B.pack bytes

60 let bs = B.pack bytes

103

104 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]

62 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]

@@ -109,8 +67,8 @@ testBytea TestEnv{..} = testGroup "Bytea"

109

110 doubleUp = concatMap (\x -> [x, x])

68 doubleUp = concatMap (\x -> [x, x])

111

112−testExecuteMany :: TestEnv -> Assertion

70+testExecuteMany :: TestEnv -> Test

113−testExecuteMany TestEnv{..} = do

71+testExecuteMany TestEnv{..} = TestCase $ do

114 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"

72 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"

115

116 let rows :: [(Int, String, Binary ByteString)]

74 let rows :: [(Int, String, Binary ByteString)]

@@ -127,8 +85,8 @@ testExecuteMany TestEnv{..} = do

127

128 return ()

86 return ()

129

130−testFold :: TestEnv -> Assertion

88+testFold :: TestEnv -> Test

131−testFold TestEnv{..} = do

89+testFold TestEnv{..} = TestCase $ do

132 xs <- fold_ conn "SELECT generate_series(1,10000)"

90 xs <- fold_ conn "SELECT generate_series(1,10000)"

133 [] $ \xs (Only x) -> return (x:xs)

91 [] $ \xs (Only x) -> return (x:xs)

134 reverse xs @?= ([1..10000] :: [Int])

92 reverse xs @?= ([1..10000] :: [Int])

@@ -139,7 +97,7 @@ testFold TestEnv{..} = do

139 xs <- readIORef ref

97 xs <- readIORef ref

140 writeIORef ref $! (a,b):xs

98 writeIORef ref $! (a,b):xs

141 xs <- readIORef ref

99 xs <- readIORef ref

142− reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]

100+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]

143

101

144 -- Make sure fold propagates our exception.

102 -- Make sure fold propagates our exception.

145 ref <- newIORef []

103 ref <- newIORef []

@@ -197,8 +155,8 @@ queryFailure conn q resultType = do

197 ++ show (typeOf resultType)

155 ++ show (typeOf resultType)

198 ++ " -> " ++ show val)

156 ++ " -> " ++ show val)

199

157

200−testArray :: TestEnv -> Assertion

158+testArray :: TestEnv -> Test

201−testArray TestEnv{..} = do

159+testArray TestEnv{..} = TestCase $ do

202 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"

160 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"

203 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]

161 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]

204 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"

162 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"

@@ -207,16 +165,8 @@ testArray TestEnv{..} = do

207 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)

165 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)

208 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)

166 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)

209

167

210−testNullableArray :: TestEnv -> Assertion

211−testNullableArray TestEnv{..} = do

212− xs <- query_ conn "SELECT '{sometext, \"NULL\"}'::_text"

213− xs @?= [Only (V.fromList ["sometext", "NULL" :: Text])]

214− xs <- query_ conn "SELECT '{sometext, NULL}'::_text"

215− xs @?= [Only (V.fromList [Just "sometext", Nothing :: Maybe Text])]

216− queryFailure conn "SELECT '{sometext, NULL}'::_text" (undefined :: V.Vector Text)

217−

218−testHStore :: TestEnv -> Assertion

168+testHStore :: TestEnv -> Test

219−testHStore TestEnv{..} = do

169+testHStore TestEnv{..} = TestCase $ do

220 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"

170 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"

221 roundTrip []

171 roundTrip []

222 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]

172 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]

@@ -228,21 +178,8 @@ testHStore TestEnv{..} = do

228 m' <- query conn "SELECT ?::hstore" m

178 m' <- query conn "SELECT ?::hstore" m

229 [m] @?= m'

179 [m] @?= m'

230

180

231−testCIText :: TestEnv -> Assertion

181+testJSON :: TestEnv -> Test

232−testCIText TestEnv{..} = do

182+testJSON TestEnv{..} = TestCase $ do

233− execute_ conn "CREATE EXTENSION IF NOT EXISTS citext"

234− roundTrip (CI.mk "")

235− roundTrip (CI.mk "UPPERCASE")

236− roundTrip (CI.mk "lowercase")

237− where

238− roundTrip :: (CI Text) -> Assertion

239− roundTrip cit = do

240− let toPostgres = Only cit

241− fromPostgres <- query conn "SELECT ?::citext" toPostgres

242− [toPostgres] @?= fromPostgres

243−

244−testJSON :: TestEnv -> Assertion

245−testJSON TestEnv{..} = do

246 roundTrip (Map.fromList [] :: Map Text Text)

183 roundTrip (Map.fromList [] :: Map Text Text)

247 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

184 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

248 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

185 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

@@ -256,92 +193,8 @@ testJSON TestEnv{..} = do

256 js' <- query conn "SELECT ?::json" js

193 js' <- query conn "SELECT ?::json" js

257 [js] @?= js'

194 [js] @?= js'

258

195

259−testAeson :: TestEnv -> Assertion

196+testSavepoint :: TestEnv -> Test

260−testAeson TestEnv{..} = do

197+testSavepoint TestEnv{..} = TestCase $ 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

345 True <- expectError ST.isNoActiveTransactionError $

198 True <- expectError ST.isNoActiveTransactionError $

346 withSavepoint conn $ return ()

199 withSavepoint conn $ return ()

347

200

@@ -401,8 +254,8 @@ testSavepoint TestEnv{..} = do

401

254

402 return ()

255 return ()

403

256

404−testUnicode :: TestEnv -> Assertion

257+testUnicode :: TestEnv -> Test

405−testUnicode TestEnv{..} = do

258+testUnicode TestEnv{..} = TestCase $ do

406 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure

259 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure

407 -- the table gets created correctly.

260 -- the table gets created correctly.

408 let messages = map Only ["привет","мир"] :: [Only Text]

261 let messages = map Only ["привет","мир"] :: [Only Text]

@@ -411,8 +264,8 @@ testUnicode TestEnv{..} = do

411 messages' <- query_ conn "SELECT сообщение FROM ру́сский"

264 messages' <- query_ conn "SELECT сообщение FROM ру́сский"

412 sort messages @?= sort messages'

265 sort messages @?= sort messages'

413

266

414−testValues :: TestEnv -> Assertion

267+testValues :: TestEnv -> Test

415−testValues TestEnv{..} = do

268+testValues TestEnv{..} = TestCase $ do

416 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"

269 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"

417 test (Values ["int4","text"] [])

270 test (Values ["int4","text"] [])

418 test (Values ["int4","text"] [(1,"hello")])

271 test (Values ["int4","text"] [(1,"hello")])

@@ -429,8 +282,8 @@ testValues TestEnv{..} = do

429 sort vals @?= sort vals'

282 sort vals @?= sort vals'

430

283

431

284

432−testCopy :: TestEnv -> Assertion

285+testCopy :: TestEnv -> Test

433−testCopy TestEnv{..} = do

286+testCopy TestEnv{..} = TestCase $ do

434 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"

287 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"

435 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"

288 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"

436 mapM_ (putCopyData conn) copyRows

289 mapM_ (putCopyData conn) copyRows

@@ -447,14 +300,6 @@ testCopy TestEnv{..} = do

447 -- so that we can issue more queries:

300 -- so that we can issue more queries:

448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

301 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

449 x @?= 4

302 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

458 where

303 where

459 copyRows = ["1,foo\n"

304 copyRows = ["1,foo\n"

460 ,"2,bar\n"]

305 ,"2,bar\n"]

@@ -465,70 +310,8 @@ testCopy TestEnv{..} = do

465 CopyOutDone _ -> return rows

310 CopyOutDone _ -> return rows

466 CopyOutRow row -> loop (row:rows)

311 CopyOutRow row -> loop (row:rows)

467

312

468−testCopyFailures :: TestEnv -> TestTree

313+testDouble :: TestEnv -> Test

469−testCopyFailures env = testGroup "Copy failures"

314+testDouble TestEnv{..} = TestCase $ do

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

532 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"

315 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"

533 assertBool "expected NaN" (isNaN x)

316 assertBool "expected NaN" (isNaN x)

534 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"

317 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"

@@ -537,45 +320,6 @@ testDouble TestEnv{..} = do

537 x @?= (-1 / 0)

320 x @?= (-1 / 0)

538

321

539

322

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−

579data TestException

323data TestException

580 = TestException

324 = TestException

581 deriving (Eq, Show, Typeable)

325 deriving (Eq, Show, Typeable)

@@ -593,56 +337,28 @@ isUniqueViolation SqlError{..} = sqlState == "23505"

593isSyntaxError :: SqlError -> Bool

337isSyntaxError :: SqlError -> Bool

594isSyntaxError SqlError{..} = sqlState == "42601"

338isSyntaxError SqlError{..} = sqlState == "42601"

595

339

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− ]

604------------------------------------------------------------------------

340------------------------------------------------------------------------

605

341

606-- | Action for connecting to the database that will be used for testing.

342-- | Action for connecting to the database that will be used for testing.

607--

343--

608-- Note that some tests, such as Notify, use multiple connections, and assume

344-- Note that some tests, such as Notify, use multiple connections, and assume

609-- that 'testConnect' connects to the same database every time it is called.

345-- that 'testConnect' connects to the same database every time it is called.

610−withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

346+testConnect :: IO Connection

611−withTestEnv connstr cb =

347+testConnect = connectPostgreSQL ""

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'"

616

348

349+withTestEnv :: (TestEnv -> IO a) -> IO a

350+withTestEnv cb =

351+ withConn $ \conn ->

617 cb TestEnv

352 cb TestEnv

618 { conn = conn

353 { conn = conn

619 , withConn = withConn

354 , withConn = withConn

620 }

355 }

621 where

356 where

622− withConn = bracket (connectPostgreSQL connstr) close

357+ withConn = bracket testConnect close

623

358

624main :: IO ()

359main :: IO ()

625−main = withConnstring $ \connstring -> do

360+main = do

626− withTestEnv connstring (defaultMain . tests)

361+ mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]

627−

362+ Counts{cases, tried, errors, failures} <-

628−withConnstring :: (BS8.ByteString -> IO ()) -> IO ()

363+ withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests

629−withConnstring kont = do

364+ when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure

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+2−1

@@ -14,8 +14,9 @@ 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 -> Assertion

17+testNotify :: TestEnv -> Test

18testNotify TestEnv{..} =

19+ TestCase $

19 withConn $ \conn2 -> do

20 withConn $ \conn2 -> do

20 execute_ conn "LISTEN foo"

21 execute_ conn "LISTEN foo"

21 execute_ conn "LISTEN bar"

22 execute_ conn "LISTEN bar"

test/Serializable.hs+2−1

@@ -23,8 +23,9 @@ putCounter conn n = do

23 1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)

24 return ()

26−testSerializable :: TestEnv -> Assertion

26+testSerializable :: TestEnv -> Test

27testSerializable TestEnv{..} =

28+ TestCase $

28 withConn $ \conn2 -> do

29 withConn $ \conn2 -> do

29 initCounter conn

30 initCounter conn

test/Time.hs+3−3

@@ -36,15 +36,15 @@ module Time (testTime) where

37import Common

38import Control.Monad(forM_, replicateM_)

39−import Data.Time.Compat

39+import Data.Time

40import Data.ByteString(ByteString)

41import Database.PostgreSQL.Simple.SqlQQ

43numTests :: Int

44numTests = 200

46−testTime :: TestEnv -> Assertion

46+testTime :: TestEnv -> Test

47−testTime env@TestEnv{..} = do

47+testTime env@TestEnv{..} = TestCase $ do

48 initializeTable env

49 execute_ conn "SET timezone TO 'UTC'"

50 checkRoundTrips env "1860-01-01 00:00:00+00"

test/results/malformed-input.expecteddeleted−4

@@ -1,4 +0,0 @@

1−user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2−Connection error: ERROR: invalid input syntax for type integer: "z"

3−CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

4−)

test/results/unique-constraint-violation.expecteddeleted−5

@@ -1,5 +0,0 @@

1−user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2−Connection error: ERROR: duplicate key value violates unique constraint "copy_unique_constraint_error_test_pkey"

3−DETAIL: Key (x)=(1) already exists.

4−CONTEXT: COPY copy_unique_constraint_error_test, line 3

5−)

tools/GenTypeInfo.hs+25−39

@@ -21,9 +21,6 @@

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−-- @

27------------------------------------------------------------------------------

24------------------------------------------------------------------------------

29{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

26{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

@@ -41,10 +38,12 @@ import Database.PostgreSQL.Simple.FromRow

41import Database.PostgreSQL.Simple.Ok

38import Database.PostgreSQL.Simple.Ok

42import Database.PostgreSQL.Simple.Types(Oid(..))

39import Database.PostgreSQL.Simple.Types(Oid(..))

43import Database.PostgreSQL.Simple.SqlQQ

40import Database.PostgreSQL.Simple.SqlQQ

44−import qualified Data.ByteString.Char8 as B8

41+import qualified Data.ByteString.Char8 as B

45import Data.ByteString(ByteString)

42import Data.ByteString(ByteString)

46import qualified Data.ByteString.Lazy as L

43import qualified Data.ByteString.Lazy as L

47−import qualified Data.ByteString.Builder as Blaze

44+import qualified Blaze.ByteString.Builder as Blaze

45+import qualified Blaze.ByteString.Builder.ByteString as Blaze

46+import qualified Blaze.ByteString.Builder.Char8 as Blaze

48import Data.String

47import Data.String

49import Data.List ( sort, intersperse )

48import Data.List ( sort, intersperse )

50import qualified Data.Map as Map

49import qualified Data.Map as Map

@@ -70,11 +69,11 @@ data TypeInfo = TypeInfo

70instance FromRow TypeInfo where

69instance FromRow TypeInfo where

71 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

70 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

73−type NameMap = Map.Map B8.ByteString TypeInfo

72+type NameMap = Map.Map B.ByteString TypeInfo

75type OidMap = Map.Map Oid TypeInfo

74type OidMap = Map.Map Oid TypeInfo

77−type TypeName = (B8.ByteString, B8.ByteString)

76+type TypeName = (B.ByteString, B.ByteString)

79type TypeNames = [TypeName]

78type TypeNames = [TypeName]

@@ -198,6 +197,9 @@ int8range

198_int8range

197_int8range

199|]

198|]

200

199

200+instance IsString Blaze.Builder where

201+ fromString = Blaze.fromByteString . fromString

202+

201connectionString = "dbname=postgres"

203connectionString = "dbname=postgres"

202

204

203withPostgreSQL = bracket (connectPostgreSQL connectionString) close

205withPostgreSQL = bracket (connectPostgreSQL connectionString) close

@@ -235,7 +237,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do

235

237

236main = do

238main = do

237 (oidmap, namemap) <- getTypeInfos typeNames

239 (oidmap, namemap) <- getTypeInfos typeNames

238− L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

240+ L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

239 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

241 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

240

242

241

243

@@ -244,7 +246,7 @@ showOid (Oid n) = show n

244renderOid :: NameMap -> TypeName -> Blaze.Builder

246renderOid :: NameMap -> TypeName -> Blaze.Builder

245renderOid byName name

247renderOid byName name

246 = case Map.lookup (pg name) byName of

248 = case Map.lookup (pg name) byName of

247− Nothing -> error (B8.unpack (pg name))

249+ Nothing -> error (B.unpack (pg name))

248 Just (showOid . typoid -> n) -> fromString n

250 Just (showOid . typoid -> n) -> fromString n

249 ++ fromString (replicate (4 - length n) ' ')

251 ++ fromString (replicate (4 - length n) ' ')

250

252

@@ -262,25 +264,20 @@ renderTypeInfo byOid info name

262 typelem_hs_name =

264 typelem_hs_name =

263 case lookup (typname typelem_info) typeNames of

265 case lookup (typname typelem_info) typeNames of

264 Nothing -> error ( "type not found: "

266 Nothing -> error ( "type not found: "

265− ++ B8.unpack( typname typelem_info)

267+ ++ B.unpack( typname typelem_info)

266− ++ " (typelem of " ++ B8.unpack (typname info)

268+ ++ " (typelem of " ++ B.unpack (typname info)

267 ++ ")")

269 ++ ")")

268 Just x -> x

270 Just x -> x

269 in concat

271 in concat

270 [ "\n"

272 [ "\n"

271 , bs (hs name), " :: TypeInfo\n"

273 , bs (hs name), " :: TypeInfo\n"

272 , bs (hs name), " = Array {\n"

274 , bs (hs name), " = Array {\n"

273− , " typoid = ", bs (hs name), "Oid,\n"

275+ , " typoid = ", fromString (show (typoid info)), ",\n"

274− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

276+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

275− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

277+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

276 , " typname = \"", bs (typname info), "\",\n"

278 , " typname = \"", bs (typname info), "\",\n"

277 , " typelem = ", bs typelem_hs_name, "\n"

279 , " typelem = ", bs typelem_hs_name, "\n"

278 , " }\n"

280 , " }\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"

284 ]

281 ]

285 | typcategory info == 'R' =

282 | typcategory info == 'R' =

286 let (Just rngsubtype_oid) = rngsubtype info

283 let (Just rngsubtype_oid) = rngsubtype info

@@ -288,41 +285,31 @@ renderTypeInfo byOid info name

288 rngsubtype_hs_name =

285 rngsubtype_hs_name =

289 case lookup (typname rngsubtype_info) typeNames of

286 case lookup (typname rngsubtype_info) typeNames of

290 Nothing -> error ( "type not found: "

287 Nothing -> error ( "type not found: "

291− ++ B8.unpack (typname rngsubtype_info)

288+ ++ B.unpack (typname rngsubtype_info)

292 ++ " (rngsubtype of "

289 ++ " (rngsubtype of "

293− ++ B8.unpack (typname info) ++ ")")

290+ ++ B.unpack (typname info) ++ ")")

294 Just x -> x

291 Just x -> x

295 in concat

292 in concat

296 [ "\n"

293 [ "\n"

297 , bs (hs name), " :: TypeInfo\n"

294 , bs (hs name), " :: TypeInfo\n"

298 , bs (hs name), " = Range {\n"

295 , bs (hs name), " = Range {\n"

299− , " typoid = ", bs (hs name), "Oid,\n"

296+ , " typoid = ", fromString (show (typoid info)), ",\n"

300− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

297+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

301− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

298+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

302 , " typname = \"", bs (typname info), "\",\n"

299 , " typname = \"", bs (typname info), "\",\n"

303 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

300 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

304 , " }\n"

301 , " }\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"

310 ]

302 ]

311 | otherwise =

303 | otherwise =

312 concat

304 concat

313 [ "\n"

305 [ "\n"

314 , bs (hs name), " :: TypeInfo\n"

306 , bs (hs name), " :: TypeInfo\n"

315 , bs (hs name), " = Basic {\n"

307 , bs (hs name), " = Basic {\n"

316− , " typoid = ", bs (hs name), "Oid,\n"

308+ , " typoid = ", fromString (show (typoid info)), ",\n"

317− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

309+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

318− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

310+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

319 , " typname = \"", bs (typname info), "\"\n"

311 , " typname = \"", bs (typname info), "\"\n"

320 , " }\n"

312 , " }\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"

326 ]

313 ]

327

314

328-- FIXME: add in any names that we need that we didn't specify, (i.e.

315-- FIXME: add in any names that we need that we didn't specify, (i.e.

@@ -331,7 +318,7 @@ renderTypeInfo byOid info name

331getNames :: NameMap -> TypeNames -> TypeNames

318getNames :: NameMap -> TypeNames -> TypeNames

332getNames _ x = x

319getNames _ x = x

333

320

334−bs = Blaze.byteString

321+bs = Blaze.fromByteString

335

322

336pg = fst

323pg = fst

337

324

@@ -360,7 +347,6 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

360 ( TypeInfo(..)

347 ( TypeInfo(..)

361 , staticTypeInfo

348 , staticTypeInfo

362|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

349|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

363− ++ " , " ++ bs (hs name) ++ "Oid\n"

364 | name <- names ] ++ [longstring|

350 | name <- names ] ++ [longstring|

365 ) where

351 ) where

366

352