cc6808d...master · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

46 files changed+2231−719

since splitsnapshots

unifiedsplit

.ghcideleted−16

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

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

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

3−

4−:set -XDoAndIfThenElse

5−:set -XOverloadedStrings

6−:set -XBangPatterns

7−:set -XViewPatterns

8−:set -XTypeOperators

9−

10−-- for tests

11−:set -XNamedFieldPuns

12−:set -XRank2Types

13−:set -XRecordWildCards

14−:set -XPatternGuards

15−:set -XScopedTypeVariables

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

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

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

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

2+#

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

4+#

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

6+#

7+# haskell-ci regenerate

8+#

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

10+#

11+# version: 0.17.20231110

12+#

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

14+#

15+name: Haskell-CI

16+on:

17+ push:

18+ branches:

19+ - master

20+ pull_request:

21+ branches:

22+ - master

23+jobs:

24+ linux:

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

26+ runs-on: ubuntu-20.04

27+ timeout-minutes:

28+ 60

29+ container:

30+ image: buildpack-deps:bionic

31+ services:

32+ postgres:

33+ image: postgres:14

34+ env:

35+ POSTGRES_PASSWORD: postgres

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

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

38+ strategy:

39+ matrix:

40+ include:

41+ - compiler: ghc-9.8.1

42+ compilerKind: ghc

43+ compilerVersion: 9.8.1

44+ setup-method: ghcup

45+ allow-failure: false

46+ - compiler: ghc-9.6.3

47+ compilerKind: ghc

48+ compilerVersion: 9.6.3

49+ setup-method: ghcup

50+ allow-failure: false

51+ - compiler: ghc-9.4.8

52+ compilerKind: ghc

53+ compilerVersion: 9.4.8

54+ setup-method: ghcup

55+ allow-failure: false

56+ - compiler: ghc-9.2.8

57+ compilerKind: ghc

58+ compilerVersion: 9.2.8

59+ setup-method: ghcup

60+ allow-failure: false

61+ - compiler: ghc-9.0.2

62+ compilerKind: ghc

63+ compilerVersion: 9.0.2

64+ setup-method: ghcup

65+ allow-failure: false

66+ - compiler: ghc-8.10.7

67+ compilerKind: ghc

68+ compilerVersion: 8.10.7

69+ setup-method: ghcup

70+ allow-failure: false

71+ - compiler: ghc-8.8.4

72+ compilerKind: ghc

73+ compilerVersion: 8.8.4

74+ setup-method: hvr-ppa

75+ allow-failure: false

76+ - compiler: ghc-8.6.5

77+ compilerKind: ghc

78+ compilerVersion: 8.6.5

79+ setup-method: hvr-ppa

80+ allow-failure: false

81+ fail-fast: false

82+ steps:

83+ - name: apt

84+ run: |

85+ apt-get update

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

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

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

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

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

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

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

93+ else

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

95+ apt-get update

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

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

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

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

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

101+ fi

102+ env:

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

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

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

106+ - name: Set PATH and environment variables

107+ run: |

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

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

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

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

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

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

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

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

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

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

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

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

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

121+ else

122+ HC=$HCDIR/bin/$HCKIND

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

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

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

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

127+ fi

128+

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

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

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

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

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

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

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

136+ env:

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

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

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

140+ - name: env

141+ run: |

142+ env

143+ - name: write cabal config

144+ run: |

145+ mkdir -p $CABAL_DIR

146+ cat >> $CABAL_CONFIG <<EOF

147+ remote-build-reporting: anonymous

148+ write-ghc-environment-files: never

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

150+ logs-dir: $CABAL_DIR/logs

151+ world-file: $CABAL_DIR/world

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

153+ symlink-bindir: $CABAL_DIR/bin

154+ installdir: $CABAL_DIR/bin

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

156+ store-dir: $CABAL_DIR/store

157+ install-dirs user

158+ prefix: $CABAL_DIR

159+ repository hackage.haskell.org

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

161+ EOF

162+ cat >> $CABAL_CONFIG <<EOF

163+ program-default-options

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

165+ EOF

166+ cat $CABAL_CONFIG

167+ - name: versions

168+ run: |

169+ $HC --version || true

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

171+ $CABAL --version || true

172+ - name: update cabal index

173+ run: |

174+ $CABAL v2-update -v

175+ - name: install cabal-plan

176+ run: |

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

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

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

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

181+ rm -f cabal-plan.xz

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

183+ cabal-plan --version

184+ - name: checkout

185+ uses: actions/checkout@v3

186+ with:

187+ path: source

188+ - name: initial cabal.project for sdist

189+ run: |

190+ touch cabal.project

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

192+ cat cabal.project

193+ - name: sdist

194+ run: |

195+ mkdir -p sdist

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

197+ - name: unpack

198+ run: |

199+ mkdir -p unpacked

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

201+ - name: generate cabal.project

202+ run: |

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

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

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

206+ touch cabal.project

207+ touch cabal.project.local

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

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

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

211+ cat >> cabal.project <<EOF

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

213+ EOF

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

215+ cat cabal.project

216+ cat cabal.project.local

217+ - name: dump install plan

218+ run: |

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

220+ cabal-plan

221+ - name: restore cache

222+ uses: actions/cache/restore@v3

223+ with:

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

225+ path: ~/.cabal/store

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

227+ - name: install dependencies

228+ run: |

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

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

231+ - name: build w/o tests

232+ run: |

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

234+ - name: build

235+ run: |

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

237+ - name: tests

238+ run: |

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

240+ - name: cabal check

241+ run: |

242+ cd ${PKGDIR_postgresql_simple} || false

243+ ${CABAL} -vnormal check

244+ - name: haddock

245+ run: |

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

247+ - name: unconstrained build

248+ run: |

249+ rm -f cabal.project.local

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

251+ - name: save cache

252+ uses: actions/cache/save@v3

253+ if: always()

254+ with:

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

256+ path: ~/.cabal/store

.github/workflows/simple.ymlnew file+58

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

1+name: Simple

2+on:

3+ push:

4+ branches:

5+ - master

6+ pull_request:

7+ branches:

8+ - master

10+jobs:

11+ native:

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

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

14+ strategy:

15+ matrix:

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

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

18+ fail-fast: false

19+ timeout-minutes:

20+ 60

21+ steps:

22+ - name: Set git to use LF

23+ run: |

24+ git config --global core.autocrlf false

25+ git config --global core.eol lf

26+

27+ - name: Set up Haskell

28+ id: setup-haskell

29+ uses: haskell/actions/setup@v2

30+ with:

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

32+ cabal-version: '3.10.2.0'

33+

34+ - name: Set up PostgreSQL

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

36+ id: postgres

37+ with:

38+ username: ci

39+ password: sw0rdfish

40+ database: test

41+

42+ - name: Checkout

43+ uses: actions/checkout@v3.0.2

44+

45+ - name: Cache

46+ uses: actions/cache@v2.1.3

47+ with:

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

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

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

51+

52+ - name: Build

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

54+

55+ - name: Test

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

57+ env:

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

.gitignore+2

@@ -13,3 +13,5 @@ dist/

1313cabal.sandbox.config

1414/dist-newstyle

1515.ghc.environment.*

16+cabal.project.local

17+dump-core

.travis.ymldeleted−123

@@ -1,123 +0,0 @@

1−# This Travis job script has been generated by a script via

2−#

3−# runghc make_travis_yml_2.hs '--output' '.travis.yml' 'postgresql-simple.cabal'

4−#

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

6−#

7−language: c

8−sudo: false

9−

10−services:

11− - postgresql

12−

13−git:

14− submodules: false # whether to recursively clone submodules

15−

16−cache:

17− directories:

18− - $HOME/.cabal/packages

19− - $HOME/.cabal/store

20−

21−before_cache:

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

23− # remove files that are regenerated by 'cabal update'

24− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

26− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

27− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

28− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

29−

30− - rm -rfv $HOME/.cabal/packages/head.hackage

31−

32−matrix:

33− include:

34− - compiler: "ghc-8.6.1"

35− # env: TEST=--disable-tests BENCH=--disable-benchmarks

36− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}}

37− - compiler: "ghc-8.4.4"

38− # env: TEST=--disable-tests BENCH=--disable-benchmarks

39− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}

40− - compiler: "ghc-8.2.2"

41− # env: TEST=--disable-tests BENCH=--disable-benchmarks

42− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}

43− - compiler: "ghc-8.0.2"

44− # env: TEST=--disable-tests BENCH=--disable-benchmarks

45− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}}

46− - compiler: "ghc-7.10.3"

47− # env: TEST=--disable-tests BENCH=--disable-benchmarks

48− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}}

49− - compiler: "ghc-7.8.4"

50− # env: TEST=--disable-tests BENCH=--disable-benchmarks

51− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}}

52− - compiler: "ghc-7.6.3"

53− # env: TEST=--disable-tests BENCH=--disable-benchmarks

54− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.6.3], sources: [hvr-ghc]}}

55−

56−before_install:

57− - HC=${CC}

58− - HCPKG=${HC/ghc/ghc-pkg}

59− - unset CC

60− - ROOTDIR=$(pwd)

61− - mkdir -p $HOME/.local/bin

62− - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

63− - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

64− - echo $HCNUMVER

65−

66−install:

67− - cabal --version

68− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

69− - BENCH=${BENCH---enable-benchmarks}

70− - TEST=${TEST---enable-tests}

71− - HADDOCK=${HADDOCK-true}

72− - UNCONSTRAINED=${UNCONSTRAINED-true}

73− - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}

74− - GHCHEAD=${GHCHEAD-false}

75− - travis_retry cabal update -v

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

77− - rm -fv cabal.project cabal.project.local

78− - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'

79− - "printf 'packages: \".\"\\n' > cabal.project"

80− - touch cabal.project.local

81− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- postgresql-simple | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"

82− - cat cabal.project || true

83− - cat cabal.project.local || true

84− - if [ -f "./configure.ac" ]; then

85− (cd "." && autoreconf -i);

86− fi

87− - rm -f cabal.project.freeze

88− - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

89− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

90− - rm -rf .ghc.environment.* "."/dist

91− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

92−

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

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

95−script:

96− # test that source-distributions can be generated

97− - cabal new-sdist all

98− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

99− - cd ${DISTDIR} || false

100− - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

101− - "printf 'packages: postgresql-simple-*/*.cabal\\n' > cabal.project"

102− - touch cabal.project.local

103− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- postgresql-simple | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"

104− - cat cabal.project || true

105− - cat cabal.project.local || true

106− # this builds all libraries and executables (without tests/benchmarks)

107− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all

108−

109− # build & run tests, build benchmarks

110− - cabal new-build -w ${HC} ${TEST} ${BENCH} all

111− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi

112−

113− # cabal check

114− - (cd postgresql-simple-* && cabal check)

115−

116− # haddock

117− - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

118−

119− # Build without installed constraints for packages in global-db

120− - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi

121−

122−# REGENDATA ["--output",".travis.yml","postgresql-simple.cabal"]

123−# EOF

CHANGES.md+82−7

@@ -1,6 +1,81 @@

1−### Version 0.6 (2018-09-25)

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

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

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.

479

580 Consider a downstream library depending already both on

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

@@ -196,7 +271,7 @@

196271 support UTF8 except for Mule Internal Code, the Multilingual

197272 Extensions for Emacs. An exception should be raised upon

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

199− accomodate this requirement.

274+ accommodate this requirement.

200275

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

202277

@@ -316,7 +391,7 @@

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

317392

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

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

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

320395

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

322397 foldWithOptions, executeMany, and returning operators.

@@ -334,7 +409,7 @@

334409

335410 * Changed the Identifier and QualifiedIdentifier to use Text in

336411 order to avoid encoding errors. Technically this requires a

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

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

338413

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

340415 and tweaked error messages.

@@ -494,7 +569,7 @@

494569

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

496571 convenient and efficient access to the pg_type metatable. This

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

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

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

499574 work on this feature.

500575

@@ -586,7 +661,7 @@

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

587662

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

589− that accomodate PostgreSQL's infinities.

664+ that accommodate PostgreSQL's infinities.

590665

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

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

CONTRIBUTING.mdnew file+13

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

1+Patches welcome!

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

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

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

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

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

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

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

11+

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

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

README.md−3

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

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

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

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

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

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

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

cabal.haskell-cinew file+5

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

1+branches: master

2+postgresql: True

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

5+-- osx: 8.4.4

cabal.project+3

@@ -1 +1,4 @@

11packages: .

2+tests: true

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

cabal.project.local.winnew file+4

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

1+constraints: these -assoc

3+package postgresql-libpq

4+ flags: -use-pkg-config

postgresql-simple.cabal+136−137

@@ -1,176 +1,175 @@

1−Cabal-version: 1.12

2−Name: postgresql-simple

3−Version: 0.6

4−

5−Synopsis: Mid-Level PostgreSQL client library

6−Description:

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

8−License: BSD3

9−License-file: LICENSE

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

11−Maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>

15−Category: Database

16−Build-type: Simple

17−

1+cabal-version: 1.12

2+name: postgresql-simple

3+version: 0.7.0.0

4+x-revision: 1

5+synopsis: Mid-Level PostgreSQL client library

6+description:

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

9+license: BSD3

10+license-file: LICENSE

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

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

13+copyright:

17+

18+category: Database

19+build-type: Simple

1820extra-source-files:

19− CONTRIBUTORS

2021 CHANGES.md

22+ CONTRIBUTORS

2123 test/results/malformed-input.expected

2224 test/results/unique-constraint-violation.expected

2325

2426tested-with:

25− GHC == 7.6.3

26− || == 7.8.4

27− || == 7.10.3

28− || == 8.0.2

29− || == 8.2.2

30− || == 8.4.4

31− || == 8.6.1

32−

33−Library

34− default-language: Haskell2010

35− hs-source-dirs: src

36− Exposed-modules:

37− Database.PostgreSQL.Simple

38− Database.PostgreSQL.Simple.Arrays

39− Database.PostgreSQL.Simple.Copy

40− Database.PostgreSQL.Simple.Cursor

41− Database.PostgreSQL.Simple.FromField

42− Database.PostgreSQL.Simple.FromRow

43− Database.PostgreSQL.Simple.LargeObjects

44− Database.PostgreSQL.Simple.HStore

45− Database.PostgreSQL.Simple.HStore.Internal

46− Database.PostgreSQL.Simple.Notification

47− Database.PostgreSQL.Simple.Ok

48− Database.PostgreSQL.Simple.Range

49− Database.PostgreSQL.Simple.SqlQQ

50− Database.PostgreSQL.Simple.Time

51− Database.PostgreSQL.Simple.Time.Internal

52− Database.PostgreSQL.Simple.ToField

53− Database.PostgreSQL.Simple.ToRow

54− Database.PostgreSQL.Simple.Transaction

55− Database.PostgreSQL.Simple.TypeInfo

56− Database.PostgreSQL.Simple.TypeInfo.Macro

57− Database.PostgreSQL.Simple.TypeInfo.Static

58− Database.PostgreSQL.Simple.Types

59− Database.PostgreSQL.Simple.Errors

60− Database.PostgreSQL.Simple.Vector

61− Database.PostgreSQL.Simple.Vector.Unboxed

62−

63−-- Other-modules:

64− Database.PostgreSQL.Simple.Internal

65−

66− Other-modules:

67− Database.PostgreSQL.Simple.Compat

68− Database.PostgreSQL.Simple.HStore.Implementation

69− Database.PostgreSQL.Simple.Internal.PQResultUtils

70− Database.PostgreSQL.Simple.Time.Implementation

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

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

73− Database.PostgreSQL.Simple.TypeInfo.Types

27+ GHC ==8.6.5

28+ || ==8.8.4

29+ || ==8.10.7

30+ || ==9.0.2

31+ || ==9.2.8

32+ || ==9.4.8

33+ || ==9.6.3

34+ || ==9.8.1

35+

36+library

37+ default-language: Haskell2010

38+ hs-source-dirs: src

39+ exposed-modules:

40+ Database.PostgreSQL.Simple

41+ Database.PostgreSQL.Simple.Arrays

42+ Database.PostgreSQL.Simple.Copy

43+ Database.PostgreSQL.Simple.Cursor

44+ Database.PostgreSQL.Simple.Errors

45+ Database.PostgreSQL.Simple.FromField

46+ Database.PostgreSQL.Simple.FromRow

47+ Database.PostgreSQL.Simple.HStore

48+ Database.PostgreSQL.Simple.HStore.Internal

49+ Database.PostgreSQL.Simple.Internal

50+ Database.PostgreSQL.Simple.LargeObjects

51+ Database.PostgreSQL.Simple.Newtypes

52+ Database.PostgreSQL.Simple.Notification

53+ Database.PostgreSQL.Simple.Ok

54+ Database.PostgreSQL.Simple.Range

55+ Database.PostgreSQL.Simple.SqlQQ

56+ Database.PostgreSQL.Simple.Time

57+ Database.PostgreSQL.Simple.Time.Internal

58+ Database.PostgreSQL.Simple.ToField

59+ Database.PostgreSQL.Simple.ToRow

60+ Database.PostgreSQL.Simple.Transaction

61+ Database.PostgreSQL.Simple.TypeInfo

62+ Database.PostgreSQL.Simple.TypeInfo.Macro

63+ Database.PostgreSQL.Simple.TypeInfo.Static

64+ Database.PostgreSQL.Simple.Types

65+ Database.PostgreSQL.Simple.Vector

66+ Database.PostgreSQL.Simple.Vector.Unboxed

67+

68+ -- Other-modules:

69+ other-modules:

70+ Database.PostgreSQL.Simple.Compat

71+ Database.PostgreSQL.Simple.HStore.Implementation

72+ Database.PostgreSQL.Simple.Internal.PQResultUtils

73+ Database.PostgreSQL.Simple.Time.Implementation

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

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

76+ Database.PostgreSQL.Simple.TypeInfo.Types

7477

7578 -- GHC bundled libs

76− Build-depends:

77− base >=4.6.0.0 && <4.13

78− , bytestring >=0.10.0.0 && <0.11

79− , containers >=0.5.0.0 && <0.7

80− , time >=1.4.0.1 && <1.9

81− , transformers >=0.3.0.0 && <0.6

82− , template-haskell >=2.8.0.0 && <2.15

83− , text >=1.2.3.0 && <1.3

79+ build-depends:

80+ base >=4.12.0.0 && <4.20

81+ , bytestring >=0.10.8.2 && <0.13

82+ , containers >=0.6.0.1 && <0.7

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

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

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

86+ , transformers >=0.5.6.2 && <0.7

8487

8588 -- Other dependencies

86− Build-depends:

87− aeson >=1.4.1.0 && <1.5

88− , attoparsec >=0.13.2.2 && <0.14

89− , bytestring-builder >=0.10.8.1.0 && <0.11

90− , case-insensitive >=1.2.0.11 && <1.3

91− , hashable >=1.2.7.0 && <1.3

92− , Only >=0.1 && <0.1.1

93− , postgresql-libpq >=0.9.4.2 && < 0.10

94− , uuid-types >=1.0.3 && <1.1

95− , scientific >=0.3.6.2 && <0.4

96− , vector >=0.12.0.1 && <0.13

97−

98− if !impl(ghc >= 8.0)

99− Build-depends:

100− semigroups >=0.18.5 && <0.19

101−

102− if !impl(ghc >= 7.6)

103− Build-depends:

104− ghc-prim

89+ build-depends:

90+ aeson >=2.1.2.1 && <2.3

91+ , attoparsec >=0.14.4 && <0.15

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

93+ , hashable >=1.4.3.0 && <1.5

94+ , Only >=0.1 && <0.1.1

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

96+ , scientific >=0.3.7.0 && <0.4

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

98+ , vector >=0.13.0.0 && <0.14

10599

106100 default-extensions:

101+ BangPatterns

107102 DoAndIfThenElse

108103 OverloadedStrings

109− BangPatterns

110− ViewPatterns

111104 TypeOperators

105+ ViewPatterns

112106

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

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

114108

115109source-repository head

116110 type: git

117− location: http://github.com/phadej/postgresql-simple

118−

119−source-repository this

120− type: git

121− location: http://github.com/phadej/postgresql-simple

122− tag: v0.6

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

123112

124−test-suite test

113+test-suite inspection

125114 default-language: Haskell2010

126− type: exitcode-stdio-1.0

115+ type: exitcode-stdio-1.0

116+ hs-source-dirs: test

117+ main-is: Inspection.hs

118+ build-depends:

119+ base

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

121+ , postgresql-libpq

122+ , postgresql-simple

123+ , tasty

124+ , tasty-hunit

127125

128− hs-source-dirs: test

129− main-is: Main.hs

126+test-suite test

127+ default-language: Haskell2010

128+ type: exitcode-stdio-1.0

129+ hs-source-dirs: test

130+ main-is: Main.hs

130131 other-modules:

131132 Common

133+ Exception

134+ Interval

132135 Notify

133136 Serializable

134137 Time

135138

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

137−

139+ ghc-options: -threaded

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

138141 default-extensions:

139142 NamedFieldPuns

140143 OverloadedStrings

144+ PatternGuards

141145 Rank2Types

142146 RecordWildCards

143− PatternGuards

144147 ScopedTypeVariables

145148

146− build-depends: base

147− , aeson

148− , base16-bytestring

149− , bytestring

150− , containers

151− , cryptohash

152− , filepath

153− , tasty

154− , tasty-hunit

155− , tasty-golden

156− , HUnit

157− , postgresql-simple

158− , text

159− , time

160− , vector

161− , case-insensitive

162−

163− if !impl(ghc >= 7.6)

164− build-depends:

165− ghc-prim

149+ build-depends:

150+ aeson

151+ , base

152+ , base16-bytestring

153+ , bytestring

154+ , case-insensitive

155+ , containers

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

157+ , filepath

158+ , HUnit

159+ , postgresql-simple

160+ , tasty

161+ , tasty-golden

162+ , tasty-hunit

163+ , text

164+ , time-compat

165+ , vector

166166

167167benchmark select

168168 default-language: Haskell2010

169169 type: exitcode-stdio-1.0

170−

171− hs-source-dirs: bench

172− main-is: Select.hs

173−

174− build-depends: base

175− , postgresql-simple

176− , vector

170+ hs-source-dirs: bench

171+ main-is: Select.hs

172+ build-depends:

173+ base

174+ , postgresql-simple

175+ , vector

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

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

6464 , Only(..)

6565 , (:.)(..)

6666 -- ** Exceptions

67+ , SomePostgreSqlException(..)

6768 , SqlError(..)

6869 , PQ.ExecStatus(..)

6970 , FormatError(..)

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

7374 , Base.connectPostgreSQL

7475 , Base.close

7576 , Base.connect

77+ , Base.withConnect

7678 , Base.ConnectInfo(..)

7779 , Base.defaultConnectInfo

7880 , Base.postgreSQLConnectionString

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

276278 skipSpace = B.dropWhile isSpace_ascii

277279

278280

279−

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

281282buildQuery conn q template xs =

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

283284 where split s =

284− let (h,t) = B.break (=='?') s

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

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

287+ let (h,t) = breakOnSingleQuestionMark s

285288 in byteString h

286289 : if B.null t

287290 then []

288291 else split (B.tail t)

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

290293 zipParams [t] [] = t

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

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

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

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

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

297+ countSingleQs = go 0 template

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

299+ go i bs = case qms of

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

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

302+ _ -> i

303+ where qms = B.splitAt 1 qmBS

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

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

294306

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

296308-- expected to return results.

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

328340-- @

329341-- executeMany c [sql|

330342-- UPDATE sometable

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

343+-- SET y = upd.y

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

333345-- WHERE sometable.x = upd.x

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

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

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

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

523535 -> IO a

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

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

525537

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

527539foldWithOptionsAndParser_ :: FoldOptions

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

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

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

533545 -> IO a

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

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

535547

536548doFold :: FoldOptions

537549 -> RowParser row

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

567579 go = bracket declare closeCursor $ \cursor ->

568580 let loop a = fetch cursor a >>=

569581 \r -> case r of

570− Left a -> return a

571− Right a -> loop a

582+ Left x -> return x

583+ Right x -> loop x

572584 in loop a0

573585

574586-- FIXME: choose the Automatic chunkSize more intelligently

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

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

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

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

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

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

894906--

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

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

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

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

4242quoted :: Parser ByteString

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

4444 where

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

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

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

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

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

4848

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

5050-- not containing the delimiter character.

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

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

1212 ) where

1313

1414import qualified Control.Exception as E

15−import Data.Monoid

1615import Data.ByteString (ByteString)

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

1816import Data.ByteString.Lazy (toStrict)

19−#else

20−import qualified Data.ByteString as B

21−import Data.ByteString.Lazy (toChunks)

22−#endif

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

24−

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

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

27−#else

28−import Data.Scientific (scientificBuilder)

29−#endif

30−

31−#if __GLASGOW_HASKELL__ >= 702

3219import System.IO.Unsafe (unsafeDupablePerformIO)

33−#elif __GLASGOW_HASKELL__ >= 611

34−import GHC.IO (unsafeDupablePerformIO)

35−#else

36−import GHC.IOBase (unsafeDupablePerformIO)

37−#endif

38−

3920import Data.Fixed (Pico)

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

4121import Data.Fixed (Fixed(MkFixed))

42−#else

43−import Unsafe.Coerce (unsafeCoerce)

44−#endif

4522

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

4724--

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

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

5229-- don't need that polymorphism.

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

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

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

56−#else

57−mask io = do

58− b <- E.blocked

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

60−#endif

6132{-# INLINE mask #-}

6233

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

64−infixr 6 <>

65−

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

67−(<>) = mappend

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

69−#endif

70−

7134toByteString :: Builder -> ByteString

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

7335toByteString x = toStrict (toLazyByteString x)

74−#else

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

76−#endif

77−

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

7936

8037toPico :: Integer -> Pico

8138toPico = MkFixed

8239

8340fromPico :: Pico -> Integer

8441fromPico (MkFixed i) = i

85−

86−#else

87−

88−toPico :: Integer -> Pico

89−toPico = unsafeCoerce

90−

91−fromPico :: Pico -> Integer

92−fromPico = unsafeCoerce

93−

94−#endif

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

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

3232 ( copy

3333 , copy_

3434 , CopyOutResult(..)

35+ , foldCopyData

3536 , getCopyData

3637 , putCopyData

3738 , putCopyEnd

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

4849import qualified Database.PostgreSQL.LibPQ as PQ

4950import Database.PostgreSQL.Simple

5051import Database.PostgreSQL.Simple.Types

51−import Database.PostgreSQL.Simple.Internal

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

5253

5354

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

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

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

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

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

5859

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

6061copy conn template qs = do

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

8586 PQ.TuplesOk -> err

8687 PQ.CopyOut -> return ()

8788 PQ.CopyIn -> return ()

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

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

90−#endif

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

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

93−#endif

9491 PQ.BadResponse -> throwResultError funcName result status

9592 PQ.NonfatalError -> throwResultError funcName result status

9693 PQ.FatalError -> throwResultError funcName result status

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

104101 deriving (Eq, Typeable, Show)

105102

106103

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

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

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

107+--

108+-- __Example__

109+--

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

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

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

113+-- > []

114+

115+foldCopyData

116+ :: Connection -- ^ Database connection

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

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

119+ -> a -- ^ Initial accumulator

120+ -> IO b -- ^ Result

121+foldCopyData conn f g !acc = do

122+ result <- getCopyData conn

123+ case result of

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

125+ CopyOutDone count -> g acc count

126+

127+

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

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

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

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

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

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

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

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

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

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

3434import Database.PostgreSQL.Simple.Internal.PQResultUtils

3535import Database.PostgreSQL.Simple.Transaction

3636import qualified Database.PostgreSQL.LibPQ as PQ

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

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

9191foldM' f a lo hi = loop a lo

9292 where

93− loop a !n

94− | n > hi = return a

93+ loop x !n

94+ | n > hi = return x

9595 | otherwise = do

96− a' <- f a n

97− loop a' (n+1)

96+ x' <- f x n

97+ loop x' (n+1)

9898{-# INLINE foldM' #-}

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

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

2525 )

2626 where

2727

28−import Control.Applicative

2928import Control.Exception as E

3029

3130import Data.Attoparsec.ByteString.Char8

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

6059 deriving (Show, Eq, Ord, Typeable)

6160

6261-- Default instance should be enough

63−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

6465

6566

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

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

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

6869--

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

7071-- > where

src/Database/PostgreSQL/Simple/FromField.hs+116−66

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

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

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

4+{-# LANGUAGE RecordWildCards #-}

5+{-# LANGUAGE PolyKinds #-}

67{- |

78Module: Database.PostgreSQL.Simple.FromField

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

106107 , PQ.Oid(..)

107108 , PQ.Format(..)

108109 , pgArrayFieldParser

110+ , attoFieldParser

109111

110112 , optionalField

111113 , fromJSONField

114+ , fromFieldJSONByteString

112115 ) where

113116

114117#include "MachDeps.h"

115118

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

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

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

118−import Control.Exception (Exception)

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

119122import qualified Data.Aeson as JSON

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

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

122124import Data.ByteString (ByteString)

123125import qualified Data.ByteString.Char8 as B

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

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

125128import Data.IORef (IORef, newIORef)

126129import Data.Ratio (Ratio)

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

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

128131import Data.Typeable (Typeable, typeOf)

129132import Data.Vector (Vector)

130133import Data.Vector.Mutable (IOVector)

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

135138import Database.PostgreSQL.Simple.Types

136139import Database.PostgreSQL.Simple.TypeInfo as TI

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

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

139141import Database.PostgreSQL.Simple.Time

140142import Database.PostgreSQL.Simple.Arrays as Arrays

141143import qualified Database.PostgreSQL.LibPQ as PQ

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

152154import Data.Scientific (Scientific)

153155import GHC.Real (infinity, notANumber)

154156

157+import qualified Data.Aeson.Types as JSON

158+

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

156160-- value fails.

157161data ResultError = Incompatible { errSQLType :: String

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

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

179183 deriving (Eq, Show, Typeable)

180184

181−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

182188

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

184190left = conversionError

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

244250 then Nothing

245251 else Just x

246252

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

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

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

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

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

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

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

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

250258

251259tableColumn :: Field -> Int

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

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

262270-- | void

263271instance FromField () where

264272 fromField f _bs

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

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

266274 | otherwise = pure ()

267275

276+instance (FromField a) => FromField (Const a b) where

277+ fromField f bs = Const <$> fromField f bs

278+

279+instance (FromField a) => FromField (Identity a) where

280+ fromField f bs = Identity <$> fromField f bs

281+

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

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

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

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

292306-- | bool

293307instance FromField Bool where

294308 fromField f bs

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

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

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

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

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

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

300314

301315-- | \"char\", bpchar

302316instance FromField Char where

303− fromField f bs =

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

305− then case bs of

317+ fromField f bs0 =

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

319+ then case bs0 of

306320 Nothing -> returnError UnexpectedNull f ""

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

308322 then returnError ConversionFailed f "length not 1"

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

311325

312326-- | int2

313327instance FromField Int16 where

314− fromField = atto ok16 $ signed decimal

328+ fromField = attoFieldParser ok16 $ signed decimal

315329

316330-- | int2, int4

317331instance FromField Int32 where

318− fromField = atto ok32 $ signed decimal

332+ fromField = attoFieldParser ok32 $ signed decimal

319333

320334#if WORD_SIZE_IN_BITS < 64

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

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

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

326340#endif

327341instance FromField Int where

328− fromField = atto okInt $ signed decimal

342+ fromField = attoFieldParser okInt $ signed decimal

329343

330344-- | int2, int4, int8

331345instance FromField Int64 where

332− fromField = atto ok64 $ signed decimal

346+ fromField = attoFieldParser ok64 $ signed decimal

333347

334348-- | int2, int4, int8

335349instance FromField Integer where

336− fromField = atto ok64 $ signed decimal

350+ fromField = attoFieldParser ok64 $ signed decimal

337351

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

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

340354instance FromField Float where

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

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

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

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

343357

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

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

346360instance FromField Double where

347− fromField = atto ok pg_double

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

361+ fromField = attoFieldParser ok pg_double

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

349363

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

351365instance FromField (Ratio Integer) where

352− fromField = atto ok pg_rational

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

366+ fromField = attoFieldParser ok pg_rational

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

354368

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

356370instance FromField Scientific where

357− fromField = atto ok rational

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

371+ fromField = attoFieldParser ok rational

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

359373

360374unBinary :: Binary t -> t

361375unBinary (Binary x) = x

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

376390

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

378392instance FromField SB.ByteString where

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

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

380394 then unBinary <$> fromField f dat

381395 else doFromField f okText' pure dat

382396

383397-- | oid

384398instance FromField PQ.Oid where

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

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

386400

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

388402instance FromField LB.ByteString where

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

390404

391405unescapeBytea :: Field -> SB.ByteString

392406 -> Conversion (Binary SB.ByteString)

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

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

394408 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

395409 Just str -> pure (Binary str)

396410

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

441455

442456-- | timestamptz

443457instance FromField UTCTime where

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

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

445459

446460-- | timestamptz

447461instance FromField ZonedTime where

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

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

449463

450464-- | timestamp

451465instance FromField LocalTime where

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

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

453467

454468-- | date

455469instance FromField Day where

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

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

457471

458472-- | time

459473instance FromField TimeOfDay where

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

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

461475

462476-- | timestamptz

463477instance FromField UTCTimestamp where

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

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

465479

466480-- | timestamptz

467481instance FromField ZonedTimestamp where

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

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

469483

470484-- | timestamp

471485instance FromField LocalTimestamp where

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

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

473487

474488-- | date

475489instance FromField Date where

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

490+ fromField = ff TI.dateOid "Date" parseDate

491+

492+-- | interval. Requires you to configure intervalstyle as @iso_8601@.

493+--

494+-- You can configure intervalstyle on every connection with a @SET@ command,

495+-- but for better performance you may want to configure it permanently in the

496+-- file found with @SHOW config_file;@ .

497+--

498+instance FromField CalendarDiffTime where

499+ fromField = ff TI.intervalOid "CalendarDiffTime" parseCalendarDiffTime

477500

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

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

480−ff compatOid hsType parse f mstr =

503+ff compatOid hsType parseBS f mstr =

481504 if typeOid f /= compatOid

482505 then err Incompatible ""

483506 else case mstr of

484507 Nothing -> err UnexpectedNull ""

485− Just str -> case parse str of

508+ Just str -> case parseBS str of

486509 Left msg -> err ConversionFailed msg

487510 Right val -> return val

488511 where

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

520543 _ -> returnError Incompatible f ""

521544

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

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

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

524547 where

525− delim = typdelim (typelem typeInfo)

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

548+ delim = typdelim (typelem typInfo)

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

527550

528551 parseIt item =

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

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

541564-- | uuid

542565instance FromField UUID where

543566 fromField f mbs =

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

567+ if typeOid f /= TI.uuidOid

545568 then returnError Incompatible f ""

546569 else case mbs of

547570 Nothing -> returnError UnexpectedNull f ""

@@ -552,22 +575,24 @@ instance FromField UUID where

552575

553576-- | json, jsonb

554577instance FromField JSON.Value where

555− fromField f mbs = parse =<< fromFieldJSONByteString f mbs

556− where parse bs = case parseOnly (JSON.value' <* endOfInput) bs of

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

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

557580 Left err -> returnError ConversionFailed f err

558581 Right val -> pure val

559582

560583-- | Return the JSON ByteString directly

584+--

585+-- @since 0.6.3

561586fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString

562587fromFieldJSONByteString f mbs =

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

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

564589 then returnError Incompatible f ""

565590 else case mbs of

566591 Nothing -> returnError UnexpectedNull f ""

567592 Just bs -> pure bs

568593

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

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

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

571596--

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

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

@@ -588,10 +613,10 @@ fromFieldJSONByteString f mbs =

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

589614fromJSONField f mbBs = do

590615 value <- fromField f mbBs

591− case JSON.fromJSON value of

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

593− "JSON decoding error: " ++ err

594− JSON.Success x -> pure x

616+ case JSON.ifromJSON value of

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

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

619+ JSON.ISuccess x -> pure x

595620

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

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

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

608633type Compat = PQ.Oid -> Bool

609634

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

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

612− TI.bpchar, TI.varchar ] )

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

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

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

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

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

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

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

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

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

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

640+okBinary = eq TI.byteaOid

641+ok16 = eq TI.int2Oid

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

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

619644#if WORD_SIZE_IN_BITS < 64

620645okInt = ok32

621646#else

622647okInt = ok64

623648#endif

624649

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+

625663doFromField :: forall a . (Typeable a)

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

627665 -> Maybe ByteString -> Conversion a

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

646684 (show (typeOf (undefined :: a)))

647685 msg

648686

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

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

651− -> Conversion a

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

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

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

689+--

690+-- @

691+-- instance FromField Int16 where

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

693+-- @

694+--

695+-- @since 0.6.3

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

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

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

699+ -> Parser a

700+ -- ^ An attoparsec parser.

701+ -> FieldParser a

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

653703 where

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

655705 go p s =

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

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

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

6868-- exception will be thrown.

6969--

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

71+-- this:

72+--

73+-- @

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

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

76+--

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

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

79+--

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

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

82+-- @

83+--

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

85+-- support sum types or recursive types.

86+--

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

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

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

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

114131 else do

115132 let !result = rowresult

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

117− !field = Field{..}

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

134+ !field' = Field{..}

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

119136

120137field :: FromField a => RowParser a

121138field = fieldWith fromField

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

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

2222import qualified Data.ByteString.Builder as BU

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

2424import qualified Data.ByteString.Lazy as BL

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

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

27−#endif

2825import Data.Map(Map)

2926import qualified Data.Map as Map

3027import Data.Text(Text)

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

5350toBuilder :: HStoreBuilder -> Builder

5451toBuilder x = case x of

5552 Empty -> mempty

56− Comma x -> x

53+ Comma c -> c

5754

5855toLazyByteString :: HStoreBuilder -> BL.ByteString

5956toLazyByteString x = case x of

6057 Empty -> BL.empty

61− Comma x -> BU.toLazyByteString x

58+ Comma c -> BU.toLazyByteString c

6259

6360instance Semigroup HStoreBuilder where

6461 Empty <> x = x

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

6966

7067instance Monoid HStoreBuilder where

7168 mempty = Empty

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

73− mappend = (<>)

74−#endif

7569

7670class ToHStoreText a where

7771 toHStoreText :: a -> HStoreText

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

150144

151145instance ToHStore HStoreMap where

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

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

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

154148

155149instance ToField HStoreMap where

156150 toField xs = toField (toHStore xs)

src/Database/PostgreSQL/Simple/Internal.hs+59−13

@@ -1,6 +1,8 @@

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

22{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

33{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

57------------------------------------------------------------------------------

68-- |

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

3436import qualified Data.IntMap as IntMap

3537import Data.IORef

3638import Data.Maybe(fromMaybe)

37−import Data.Monoid

3839import Data.String

3940import qualified Data.Text as T

4041import qualified Data.Text.Encoding as TE

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

8283instance Eq Connection where

8384 x == y = connectionHandle x == connectionHandle y

8485

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+

85105data SqlError = SqlError {

86106 sqlState :: ByteString

87107 , sqlExecStatus :: ExecStatus

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

93113fatalError :: ByteString -> SqlError

94114fatalError msg = SqlError "" FatalError msg "" ""

95115

96−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

97120

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

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

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

102125 , qeQuery :: Query

103126 } deriving (Eq, Show, Typeable)

104127

105−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

106131

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

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

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

113138 , fmtParams :: [ByteString]

114139 } deriving (Eq, Show, Typeable)

115140

116−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

117144

118145data ConnectInfo = ConnectInfo {

119146 connectHost :: String

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

155182connect :: ConnectInfo -> IO Connection

156183connect = connectPostgreSQL . postgreSQLConnectionString

157184

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+

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

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

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

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

290323

291324 str name field

292325 | null value = id

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

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

294327 where value = field connectInfo

295328

296329 num name field

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

298331 | otherwise = showString name . shows value . space

299332 where value = field connectInfo

300333

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

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

302335 where

303336 delta c cs = case c of

304337 '\\' -> '\\' : '\\' : cs

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

386419 nstr <- PQ.cmdTuples result

387420 return $ case nstr of

388421 Nothing -> 0 -- is this appropriate?

389− Just str -> toInteger str

422+ Just str -> mkInteger str

390423 PQ.TuplesOk -> do

391424 ncols <- PQ.nfields result

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

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

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

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

401434 where

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

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

403436 where

404437 delta acc c =

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

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

414447 PQ.resultErrorField result PQ.DiagMessageDetail

415448 hint <- fromMaybe "" <$>

416449 PQ.resultErrorField result PQ.DiagMessageHint

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

418− throwIO $ SqlError { sqlState = state

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

451+ throwIO $ SqlError { sqlState = state'

419452 , sqlExecStatus = status

420453 , sqlErrorMsg = errormsg

421454 , sqlErrorDetail = detail

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

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

485518

486519instance Monad Conversion where

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

488− return = pure

489−#endif

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

491521 oka <- runConversion m conn

492522 case oka of

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

589619

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

591621escapeByteaConn = escapeWrap PQ.escapeByteaConn

622+

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

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

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

626+ -- seperate from first QM

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

628+ -- if end of query, just return

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

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

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

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

633+ -- another QM after the first means:

634+ -- take literal QM and keep going.

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

636+ -- Anything else means

637+ go2 _ = tup

src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+2−6

@@ -25,7 +25,7 @@ import Data.Foldable (for_)

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

2626import Database.PostgreSQL.Simple.Ok

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

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

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

2929import Database.PostgreSQL.Simple.TypeInfo

3030import qualified Database.PostgreSQL.LibPQ as PQ

3131import qualified Data.ByteString.Char8 as B

@@ -73,15 +73,11 @@ finishQueryWith' q result k = do

7373 case status of

7474 PQ.TuplesOk -> k

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

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

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

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

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

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

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

81−#endif

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

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

84−#endif

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

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

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

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

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

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE DeriveDataTypeable #-}

3+-- | Module with newtypes suitable to usage with @DerivingVia@ or standalone.

4+--

5+-- The newtypes are named after packages they wrap.

6+module Database.PostgreSQL.Simple.Newtypes (

7+ Aeson (..), getAeson,

8+) where

10+import Data.Typeable (Typeable)

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

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

13+

14+import qualified Data.Aeson as Aeson

15+

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

17+-- aeson

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

19+

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

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

22+--

23+-- Example using @DerivingVia@:

24+--

25+-- @

26+-- data Foo = Foo Int String

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

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

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

30+-- @

31+--

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

33+--

34+-- @

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

36+-- @

37+--

38+-- @since 0.6.3

39+newtype Aeson a = Aeson a

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

41+

42+getAeson :: Aeson a -> a

43+getAeson (Aeson a) = a

44+

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

46+ toField = toField . Aeson.encode . getAeson

47+

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

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

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

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

4747

4848#if defined(mingw32_HOST_OS)

4949import Control.Concurrent ( threadDelay )

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

51−import Control.Concurrent ( threadWaitRead )

5250#else

5351import GHC.Conc ( atomically )

5452import Control.Concurrent ( threadWaitReadSTM )

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

9492 -- with async exceptions, whereas threadDelay can.

9593 Just _fd -> do

9694 return (threadDelay 1000000 >> loop)

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

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

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

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

101− -- descriptor before we call threadWaitRead, then

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

103− --

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

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

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

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

108− Just fd -> do

109− return $ do

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

111− loop

11295#else

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

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

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

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

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

3838import Data.Typeable

3939

40+import qualified Control.Monad.Fail as Fail

41+

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

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

4244

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

7072 mplus = (<|>)

7173

7274instance Monad Ok where

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

74− return = pure

75−#endif

76−

7775 Errors es >>= _ = Errors es

7876 Ok a >>= f = f a

7977

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

79+ fail = Fail.fail

80+#endif

81+

82+instance Fail.MonadFail Ok where

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

8184

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

src/Database/PostgreSQL/Simple/Range.hs+7−7

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

3838import Data.Scientific (Scientific)

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

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

41−import Data.Time (Day, LocalTime,

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

4242 NominalDiffTime,

4343 TimeOfDay, UTCTime,

4444 ZonedTime,

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

110110 PGRange _lb NegInfinity -> False

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

112112 where

113− checkLB lb x =

113+ checkLB lb y =

114114 case lb of

115115 NegInfinity -> True

116116 PosInfinity -> False

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

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

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

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

119119

120− checkUB ub x =

120+ checkUB ub y =

121121 case ub of

122122 NegInfinity -> False

123123 PosInfinity -> True

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

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

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

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

126126

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

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

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

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

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

15{-# LANGUAGE TemplateHaskell #-}

6+#endif

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

38-- |

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

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

3035-- > (beginTime,endTime,string)

3136--

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

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

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

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

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

3641--

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

5257

5358sql :: QuasiQuoter

5459sql = QuasiQuoter

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

56− \ quasiquoter used in pattern context"

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

58− \ quasiquoter used in type context"

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

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

5962 , quoteExp = sqlExp

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

61− \ quasiquoter used in declaration context"

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

6264 }

6365

6466sqlExp :: String -> Q Exp

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

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

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

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

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

89− \ string literal not terminated"

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

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

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

227227 , parseUTCTimestamp

228228 , parseZonedTimestamp

229229 , parseLocalTimestamp

230+ , parseCalendarDiffTime

230231 , dayToBuilder

231232 , utcTimeToBuilder

232233 , zonedTimeToBuilder

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

239240 , localTimestampToBuilder

240241 , unboundedToBuilder

241242 , nominalDiffTimeToBuilder

243+ , calendarDiffTimeToBuilder

242244 ) where

243245

244246import Database.PostgreSQL.Simple.Time.Implementation

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

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

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

1919import Control.Applicative

2020import qualified Data.ByteString as B

21−import Data.Time hiding (getTimeZone, getZonedTime)

21+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)

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

2223import Data.Typeable

2324import Data.Maybe (fromMaybe)

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

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

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

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

7980

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

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

83+

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

8185getUnbounded getFinite

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

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

125129getUTCTimestamp :: A.Parser UTCTimestamp

126130getUTCTimestamp = getUnbounded getUTCTime

127131

132+getCalendarDiffTime :: A.Parser CalendarDiffTime

133+getCalendarDiffTime = TP.calendarDiffTime

134+

128135dayToBuilder :: Day -> Builder

129136dayToBuilder = primBounded TPP.day

130137

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

164171

165172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

166173nominalDiffTimeToBuilder = TPP.nominalDiffTime

174+

175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

176+calendarDiffTimeToBuilder = TPP.calendarDiffTime

src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+12−3

@@ -21,20 +21,24 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser

2121 , localToUTCTimeOfDayHMS

2222 , utcTime

2323 , zonedTime

24+ , calendarDiffTime

2425 ) where

2526

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

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

2829import Data.Attoparsec.ByteString.Char8 as A

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

31+import Data.ByteString (ByteString)

3032import Data.Char (ord)

3133import Data.Fixed (Pico)

3234import Data.Int (Int64)

3335import Data.Maybe (fromMaybe)

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

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

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

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

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

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

3640import qualified Data.ByteString.Char8 as B8

37−import qualified Data.Time.LocalTime as Local

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

3842

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

4044day :: Parser Day

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

193197

194198utc :: Local.TimeZone

195199utc = Local.TimeZone 0 False ""

200+

201+calendarDiffTime :: Parser CalendarDiffTime

202+calendarDiffTime = do

203+ contents <- takeByteString

204+ iso8601ParseM $ B8.unpack contents

src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+14−2

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

1717 , localTime

1818 , zonedTime

1919 , nominalDiffTime

20+ , calendarDiffTime

2021 ) where

2122

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

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

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

2425import Data.ByteString.Builder.Prim

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

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

2728import Data.Char ( chr )

2829import Data.Int ( Int32, Int64 )

29−import Data.Time

30+import Data.String (fromString)

31+import Data.Time.Compat

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

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

3234 , TimeZone, timeZoneMinutes )

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

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

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

3438import Unsafe.Coerce (unsafeCoerce)

3539

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

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

122126 where

123127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

128+

129+calendarDiffTime :: CalendarDiffTime -> Builder

130+calendarDiffTime = byteString

131+ . fromString

132+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".

133+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted

134+ -- to ASCII output.

135+ . iso8601Show

src/Database/PostgreSQL/Simple/ToField.hs+22−11

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

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3+{-# LANGUAGE PolyKinds #-}

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

56-- |

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

2223 , inQuotes

2324 ) where

2425

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

2527import qualified Data.Aeson as JSON

2628import Data.ByteString (ByteString)

2729import Data.ByteString.Builder

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

3032 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

3133 , floatDec, doubleDec

3234 )

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

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

3437import Data.List (intersperse)

3538import Data.Monoid (mappend)

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

39+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

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

3741import Data.Typeable (Typeable)

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

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

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

5559import qualified Database.PostgreSQL.LibPQ as PQ

5660import Database.PostgreSQL.Simple.Time

5761import Data.Scientific (Scientific)

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

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

60−#else

61−import Data.Scientific (scientificBuilder)

62−#endif

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

6464

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

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

100100 toField a = a

101101 {-# INLINE toField #-}

102102

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

104+ toField (Const a) = toField a

105+ {-# INLINE toField #-}

106+

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

108+ toField (Identity a) = toField a

109+ {-# INLINE toField #-}

110+

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

104112 toField Nothing = renderNull

105113 toField (Just a) = toField a

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

282290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

283291 {-# INLINE toField #-}

284292

293+instance ToField CalendarDiffTime where

294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

295+ {-# INLINE toField #-}

296+

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

286298 toField pgArray =

287299 case fromPGArray pgArray of

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

302314instance ToField JSON.Value where

303315 toField = toField . JSON.encode

304316

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

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

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

307318--

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

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

310321-- PostgreSQL.

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

312−toJSONField = toField . JSON.toJSON

323+toJSONField = toField . JSON.encode

313324

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

315326--

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

319330 where quote = char8 '\''

320331

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

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

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

323334{-# INLINE interleaveFoldr #-}

324335

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

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

366377

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

368379 typedRows [] _ _ = error funcname

369− typedRows (val:vals) types rest =

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

380+ typedRows (val:vals) typs rest =

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

371382

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

373384 untypedRows [] _ = error funcname

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

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

3030--

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

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

33+--

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

35+--

36+-- @

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

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

39+--

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

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

42+--

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

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

45+-- @

46+--

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

48+-- support sum types or recursive types.

3349class ToRow a where

3450 toRow :: a -> [Action]

3551 default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

src/Database/PostgreSQL/Simple/Transaction.hs+16−12

@@ -17,6 +17,7 @@ module Database.PostgreSQL.Simple.Transaction

1717 , withTransactionLevel

1818 , withTransactionMode

1919 , withTransactionModeRetry

20+ , withTransactionModeRetry'

2021 , withTransactionSerializable

2122 , TransactionMode(..)

2223 , IsolationLevel(..)

@@ -146,31 +147,34 @@ withTransactionMode mode conn act =

146147 commit conn

147148 return r

148149

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

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

152+withTransactionModeRetry = withTransactionModeRetry'

153+

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

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

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

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

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

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

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

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

154159--

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

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

157−withTransactionModeRetry mode shouldRetry conn act =

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

162+withTransactionModeRetry' mode shouldRetry conn act =

158163 mask $ \restore ->

159164 retryLoop $ E.try $ do

160− a <- restore act

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

161166 commit conn

162167 return a

163168 where

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

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

165170 retryLoop act' = do

166171 beginMode mode conn

167172 r <- act'

168173 case r of

169− Left e -> do

170− rollback_ conn

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

172− Just True -> retryLoop act'

173− _ -> E.throwIO e

174+ Left e ->

175+ case shouldRetry e of

176+ True -> retryLoop act'

177+ False -> E.throwIO e

174178 Right a ->

175179 return a

176180

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

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

5050-- in the connections's cache.

5151

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

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

54− case staticTypeInfo oid of

55− Just name -> return name

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

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

54+ case staticTypeInfo oid' of

55+ Just name' -> return name'

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

5757

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

5959 -> IO (TypeInfoCache, TypeInfo)

60−getTypeInfo' conn oid oidmap =

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

60+getTypeInfo' conn oid' oidmap =

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

6262 Just typeinfo -> return (oidmap, typeinfo)

6363 Nothing -> do

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

6565 \ typelem, typrelid\

6666 \ FROM pg_type WHERE oid = ?"

67− (Only oid)

67+ (Only oid')

6868 (oidmap', typeInfo) <-

6969 case names of

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

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

7878 rngsubtypeOids <- query conn "SELECT rngsubtype\

7979 \ FROM pg_range\

8080 \ WHERE rngtypid = ?"

81− (Only oid)

81+ (Only oid')

8282 case rngsubtypeOids of

8383 [Only rngsubtype_] -> do

8484 (oidmap', rngsubtype) <-

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

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

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

106106 -- never return more than one result

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

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

108108 return $! (oidmap'', typeInfo)

109109

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

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

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

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

15{-# LANGUAGE TemplateHaskell #-}

6+#endif

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

49-- |

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

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

2328import Language.Haskell.TH

2429

25−

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

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

2832mkCompats :: [TypeInfo] -> ExpQ

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

33+mkCompats tys = do

34+ x <- newName "x"

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

3036 where

3137 alt :: TypeInfo -> MatchQ

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

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

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

3945-- not to fold constants.

4046inlineTypoid :: TypeInfo -> ExpQ

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

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

4248

4349inlineTypoidP :: TypeInfo -> PatQ

4450inlineTypoidP ty = litP (getTypoid ty)

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

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

1919 ( TypeInfo(..)

2020 , staticTypeInfo

2121 , bool

22+ , boolOid

2223 , bytea

24+ , byteaOid

2325 , char

26+ , charOid

2427 , name

28+ , nameOid

2529 , int8

30+ , int8Oid

2631 , int2

32+ , int2Oid

2733 , int4

34+ , int4Oid

2835 , regproc

36+ , regprocOid

2937 , text

38+ , textOid

3039 , oid

40+ , oidOid

3141 , tid

42+ , tidOid

3243 , xid

44+ , xidOid

3345 , cid

46+ , cidOid

3447 , xml

48+ , xmlOid

3549 , point

50+ , pointOid

3651 , lseg

52+ , lsegOid

3753 , path

54+ , pathOid

3855 , box

56+ , boxOid

3957 , polygon

58+ , polygonOid

4059 , line

60+ , lineOid

4161 , cidr

62+ , cidrOid

4263 , float4

64+ , float4Oid

4365 , float8

66+ , float8Oid

4467 , unknown

68+ , unknownOid

4569 , circle

70+ , circleOid

4671 , money

72+ , moneyOid

4773 , macaddr

74+ , macaddrOid

4875 , inet

76+ , inetOid

4977 , bpchar

78+ , bpcharOid

5079 , varchar

80+ , varcharOid

5181 , date

82+ , dateOid

5283 , time

84+ , timeOid

5385 , timestamp

86+ , timestampOid

5487 , timestamptz

88+ , timestamptzOid

5589 , interval

90+ , intervalOid

5691 , timetz

92+ , timetzOid

5793 , bit

94+ , bitOid

5895 , varbit

96+ , varbitOid

5997 , numeric

98+ , numericOid

6099 , refcursor

100+ , refcursorOid

61101 , record

102+ , recordOid

62103 , void

104+ , voidOid

63105 , array_record

106+ , array_recordOid

64107 , regprocedure

108+ , regprocedureOid

65109 , regoper

110+ , regoperOid

66111 , regoperator

112+ , regoperatorOid

67113 , regclass

114+ , regclassOid

68115 , regtype

116+ , regtypeOid

69117 , uuid

118+ , uuidOid

70119 , json

120+ , jsonOid

71121 , jsonb

122+ , jsonbOid

72123 , int2vector

124+ , int2vectorOid

73125 , oidvector

126+ , oidvectorOid

74127 , array_xml

128+ , array_xmlOid

75129 , array_json

130+ , array_jsonOid

76131 , array_line

132+ , array_lineOid

77133 , array_cidr

134+ , array_cidrOid

78135 , array_circle

136+ , array_circleOid

79137 , array_money

138+ , array_moneyOid

80139 , array_bool

140+ , array_boolOid

81141 , array_bytea

142+ , array_byteaOid

82143 , array_char

144+ , array_charOid

83145 , array_name

146+ , array_nameOid

84147 , array_int2

148+ , array_int2Oid

85149 , array_int2vector

150+ , array_int2vectorOid

86151 , array_int4

152+ , array_int4Oid

87153 , array_regproc

154+ , array_regprocOid

88155 , array_text

156+ , array_textOid

89157 , array_tid

158+ , array_tidOid

90159 , array_xid

160+ , array_xidOid

91161 , array_cid

162+ , array_cidOid

92163 , array_oidvector

164+ , array_oidvectorOid

93165 , array_bpchar

166+ , array_bpcharOid

94167 , array_varchar

168+ , array_varcharOid

95169 , array_int8

170+ , array_int8Oid

96171 , array_point

172+ , array_pointOid

97173 , array_lseg

174+ , array_lsegOid

98175 , array_path

176+ , array_pathOid

99177 , array_box

178+ , array_boxOid

100179 , array_float4

180+ , array_float4Oid

101181 , array_float8

182+ , array_float8Oid

102183 , array_polygon

184+ , array_polygonOid

103185 , array_oid

186+ , array_oidOid

104187 , array_macaddr

188+ , array_macaddrOid

105189 , array_inet

190+ , array_inetOid

106191 , array_timestamp

192+ , array_timestampOid

107193 , array_date

194+ , array_dateOid

108195 , array_time

196+ , array_timeOid

109197 , array_timestamptz

198+ , array_timestamptzOid

110199 , array_interval

200+ , array_intervalOid

111201 , array_numeric

202+ , array_numericOid

112203 , array_timetz

204+ , array_timetzOid

113205 , array_bit

206+ , array_bitOid

114207 , array_varbit

208+ , array_varbitOid

115209 , array_refcursor

210+ , array_refcursorOid

116211 , array_regprocedure

212+ , array_regprocedureOid

117213 , array_regoper

214+ , array_regoperOid

118215 , array_regoperator

216+ , array_regoperatorOid

119217 , array_regclass

218+ , array_regclassOid

120219 , array_regtype

220+ , array_regtypeOid

121221 , array_uuid

222+ , array_uuidOid

122223 , array_jsonb

224+ , array_jsonbOid

123225 , int4range

226+ , int4rangeOid

124227 , _int4range

228+ , _int4rangeOid

125229 , numrange

230+ , numrangeOid

126231 , _numrange

232+ , _numrangeOid

127233 , tsrange

234+ , tsrangeOid

128235 , _tsrange

236+ , _tsrangeOid

129237 , tstzrange

238+ , tstzrangeOid

130239 , _tstzrange

240+ , _tstzrangeOid

131241 , daterange

242+ , daterangeOid

132243 , _daterange

244+ , _daterangeOid

133245 , int8range

246+ , int8rangeOid

134247 , _int8range

248+ , _int8rangeOid

135249 ) where

136250

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

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

257371

258372bool :: TypeInfo

259373bool = Basic {

260− typoid = Oid 16,

374+ typoid = boolOid,

261375 typcategory = 'B',

262376 typdelim = ',',

263377 typname = "bool"

264378 }

265379

380+boolOid :: Oid

381+boolOid = Oid 16

382+{-# INLINE boolOid #-}

383+

266384bytea :: TypeInfo

267385bytea = Basic {

268− typoid = Oid 17,

386+ typoid = byteaOid,

269387 typcategory = 'U',

270388 typdelim = ',',

271389 typname = "bytea"

272390 }

273391

392+byteaOid :: Oid

393+byteaOid = Oid 17

394+{-# INLINE byteaOid #-}

395+

274396char :: TypeInfo

275397char = Basic {

276− typoid = Oid 18,

398+ typoid = charOid,

277399 typcategory = 'S',

278400 typdelim = ',',

279401 typname = "char"

280402 }

281403

404+charOid :: Oid

405+charOid = Oid 18

406+{-# INLINE charOid #-}

407+

282408name :: TypeInfo

283409name = Basic {

284− typoid = Oid 19,

410+ typoid = nameOid,

285411 typcategory = 'S',

286412 typdelim = ',',

287413 typname = "name"

288414 }

289415

416+nameOid :: Oid

417+nameOid = Oid 19

418+{-# INLINE nameOid #-}

419+

290420int8 :: TypeInfo

291421int8 = Basic {

292− typoid = Oid 20,

422+ typoid = int8Oid,

293423 typcategory = 'N',

294424 typdelim = ',',

295425 typname = "int8"

296426 }

297427

428+int8Oid :: Oid

429+int8Oid = Oid 20

430+{-# INLINE int8Oid #-}

431+

298432int2 :: TypeInfo

299433int2 = Basic {

300− typoid = Oid 21,

434+ typoid = int2Oid,

301435 typcategory = 'N',

302436 typdelim = ',',

303437 typname = "int2"

304438 }

305439

440+int2Oid :: Oid

441+int2Oid = Oid 21

442+{-# INLINE int2Oid #-}

443+

306444int4 :: TypeInfo

307445int4 = Basic {

308− typoid = Oid 23,

446+ typoid = int4Oid,

309447 typcategory = 'N',

310448 typdelim = ',',

311449 typname = "int4"

312450 }

313451

452+int4Oid :: Oid

453+int4Oid = Oid 23

454+{-# INLINE int4Oid #-}

455+

314456regproc :: TypeInfo

315457regproc = Basic {

316− typoid = Oid 24,

458+ typoid = regprocOid,

317459 typcategory = 'N',

318460 typdelim = ',',

319461 typname = "regproc"

320462 }

321463

464+regprocOid :: Oid

465+regprocOid = Oid 24

466+{-# INLINE regprocOid #-}

467+

322468text :: TypeInfo

323469text = Basic {

324− typoid = Oid 25,

470+ typoid = textOid,

325471 typcategory = 'S',

326472 typdelim = ',',

327473 typname = "text"

328474 }

329475

476+textOid :: Oid

477+textOid = Oid 25

478+{-# INLINE textOid #-}

479+

330480oid :: TypeInfo

331481oid = Basic {

332− typoid = Oid 26,

482+ typoid = oidOid,

333483 typcategory = 'N',

334484 typdelim = ',',

335485 typname = "oid"

336486 }

337487

488+oidOid :: Oid

489+oidOid = Oid 26

490+{-# INLINE oidOid #-}

491+

338492tid :: TypeInfo

339493tid = Basic {

340− typoid = Oid 27,

494+ typoid = tidOid,

341495 typcategory = 'U',

342496 typdelim = ',',

343497 typname = "tid"

344498 }

345499

500+tidOid :: Oid

501+tidOid = Oid 27

502+{-# INLINE tidOid #-}

503+

346504xid :: TypeInfo

347505xid = Basic {

348− typoid = Oid 28,

506+ typoid = xidOid,

349507 typcategory = 'U',

350508 typdelim = ',',

351509 typname = "xid"

352510 }

353511

512+xidOid :: Oid

513+xidOid = Oid 28

514+{-# INLINE xidOid #-}

515+

354516cid :: TypeInfo

355517cid = Basic {

356− typoid = Oid 29,

518+ typoid = cidOid,

357519 typcategory = 'U',

358520 typdelim = ',',

359521 typname = "cid"

360522 }

361523

524+cidOid :: Oid

525+cidOid = Oid 29

526+{-# INLINE cidOid #-}

527+

362528xml :: TypeInfo

363529xml = Basic {

364− typoid = Oid 142,

530+ typoid = xmlOid,

365531 typcategory = 'U',

366532 typdelim = ',',

367533 typname = "xml"

368534 }

369535

536+xmlOid :: Oid

537+xmlOid = Oid 142

538+{-# INLINE xmlOid #-}

539+

370540point :: TypeInfo

371541point = Basic {

372− typoid = Oid 600,

542+ typoid = pointOid,

373543 typcategory = 'G',

374544 typdelim = ',',

375545 typname = "point"

376546 }

377547

548+pointOid :: Oid

549+pointOid = Oid 600

550+{-# INLINE pointOid #-}

551+

378552lseg :: TypeInfo

379553lseg = Basic {

380− typoid = Oid 601,

554+ typoid = lsegOid,

381555 typcategory = 'G',

382556 typdelim = ',',

383557 typname = "lseg"

384558 }

385559

560+lsegOid :: Oid

561+lsegOid = Oid 601

562+{-# INLINE lsegOid #-}

563+

386564path :: TypeInfo

387565path = Basic {

388− typoid = Oid 602,

566+ typoid = pathOid,

389567 typcategory = 'G',

390568 typdelim = ',',

391569 typname = "path"

392570 }

393571

572+pathOid :: Oid

573+pathOid = Oid 602

574+{-# INLINE pathOid #-}

575+

394576box :: TypeInfo

395577box = Basic {

396− typoid = Oid 603,

578+ typoid = boxOid,

397579 typcategory = 'G',

398580 typdelim = ';',

399581 typname = "box"

400582 }

401583

584+boxOid :: Oid

585+boxOid = Oid 603

586+{-# INLINE boxOid #-}

587+

402588polygon :: TypeInfo

403589polygon = Basic {

404− typoid = Oid 604,

590+ typoid = polygonOid,

405591 typcategory = 'G',

406592 typdelim = ',',

407593 typname = "polygon"

408594 }

409595

596+polygonOid :: Oid

597+polygonOid = Oid 604

598+{-# INLINE polygonOid #-}

599+

410600line :: TypeInfo

411601line = Basic {

412− typoid = Oid 628,

602+ typoid = lineOid,

413603 typcategory = 'G',

414604 typdelim = ',',

415605 typname = "line"

416606 }

417607

608+lineOid :: Oid

609+lineOid = Oid 628

610+{-# INLINE lineOid #-}

611+

418612cidr :: TypeInfo

419613cidr = Basic {

420− typoid = Oid 650,

614+ typoid = cidrOid,

421615 typcategory = 'I',

422616 typdelim = ',',

423617 typname = "cidr"

424618 }

425619

620+cidrOid :: Oid

621+cidrOid = Oid 650

622+{-# INLINE cidrOid #-}

623+

426624float4 :: TypeInfo

427625float4 = Basic {

428− typoid = Oid 700,

626+ typoid = float4Oid,

429627 typcategory = 'N',

430628 typdelim = ',',

431629 typname = "float4"

432630 }

433631

632+float4Oid :: Oid

633+float4Oid = Oid 700

634+{-# INLINE float4Oid #-}

635+

434636float8 :: TypeInfo

435637float8 = Basic {

436− typoid = Oid 701,

638+ typoid = float8Oid,

437639 typcategory = 'N',

438640 typdelim = ',',

439641 typname = "float8"

440642 }

441643

644+float8Oid :: Oid

645+float8Oid = Oid 701

646+{-# INLINE float8Oid #-}

647+

442648unknown :: TypeInfo

443649unknown = Basic {

444− typoid = Oid 705,

650+ typoid = unknownOid,

445651 typcategory = 'X',

446652 typdelim = ',',

447653 typname = "unknown"

448654 }

449655

656+unknownOid :: Oid

657+unknownOid = Oid 705

658+{-# INLINE unknownOid #-}

659+

450660circle :: TypeInfo

451661circle = Basic {

452− typoid = Oid 718,

662+ typoid = circleOid,

453663 typcategory = 'G',

454664 typdelim = ',',

455665 typname = "circle"

456666 }

457667

668+circleOid :: Oid

669+circleOid = Oid 718

670+{-# INLINE circleOid #-}

671+

458672money :: TypeInfo

459673money = Basic {

460− typoid = Oid 790,

674+ typoid = moneyOid,

461675 typcategory = 'N',

462676 typdelim = ',',

463677 typname = "money"

464678 }

465679

680+moneyOid :: Oid

681+moneyOid = Oid 790

682+{-# INLINE moneyOid #-}

683+

466684macaddr :: TypeInfo

467685macaddr = Basic {

468− typoid = Oid 829,

686+ typoid = macaddrOid,

469687 typcategory = 'U',

470688 typdelim = ',',

471689 typname = "macaddr"

472690 }

473691

692+macaddrOid :: Oid

693+macaddrOid = Oid 829

694+{-# INLINE macaddrOid #-}

695+

474696inet :: TypeInfo

475697inet = Basic {

476− typoid = Oid 869,

698+ typoid = inetOid,

477699 typcategory = 'I',

478700 typdelim = ',',

479701 typname = "inet"

480702 }

481703

704+inetOid :: Oid

705+inetOid = Oid 869

706+{-# INLINE inetOid #-}

707+

482708bpchar :: TypeInfo

483709bpchar = Basic {

484− typoid = Oid 1042,

710+ typoid = bpcharOid,

485711 typcategory = 'S',

486712 typdelim = ',',

487713 typname = "bpchar"

488714 }

489715

716+bpcharOid :: Oid

717+bpcharOid = Oid 1042

718+{-# INLINE bpcharOid #-}

719+

490720varchar :: TypeInfo

491721varchar = Basic {

492− typoid = Oid 1043,

722+ typoid = varcharOid,

493723 typcategory = 'S',

494724 typdelim = ',',

495725 typname = "varchar"

496726 }

497727

728+varcharOid :: Oid

729+varcharOid = Oid 1043

730+{-# INLINE varcharOid #-}

731+

498732date :: TypeInfo

499733date = Basic {

500− typoid = Oid 1082,

734+ typoid = dateOid,

501735 typcategory = 'D',

502736 typdelim = ',',

503737 typname = "date"

504738 }

505739

740+dateOid :: Oid

741+dateOid = Oid 1082

742+{-# INLINE dateOid #-}

743+

506744time :: TypeInfo

507745time = Basic {

508− typoid = Oid 1083,

746+ typoid = timeOid,

509747 typcategory = 'D',

510748 typdelim = ',',

511749 typname = "time"

512750 }

513751

752+timeOid :: Oid

753+timeOid = Oid 1083

754+{-# INLINE timeOid #-}

755+

514756timestamp :: TypeInfo

515757timestamp = Basic {

516− typoid = Oid 1114,

758+ typoid = timestampOid,

517759 typcategory = 'D',

518760 typdelim = ',',

519761 typname = "timestamp"

520762 }

521763

764+timestampOid :: Oid

765+timestampOid = Oid 1114

766+{-# INLINE timestampOid #-}

767+

522768timestamptz :: TypeInfo

523769timestamptz = Basic {

524− typoid = Oid 1184,

770+ typoid = timestamptzOid,

525771 typcategory = 'D',

526772 typdelim = ',',

527773 typname = "timestamptz"

528774 }

529775

776+timestamptzOid :: Oid

777+timestamptzOid = Oid 1184

778+{-# INLINE timestamptzOid #-}

779+

530780interval :: TypeInfo

531781interval = Basic {

532− typoid = Oid 1186,

782+ typoid = intervalOid,

533783 typcategory = 'T',

534784 typdelim = ',',

535785 typname = "interval"

536786 }

537787

788+intervalOid :: Oid

789+intervalOid = Oid 1186

790+{-# INLINE intervalOid #-}

791+

538792timetz :: TypeInfo

539793timetz = Basic {

540− typoid = Oid 1266,

794+ typoid = timetzOid,

541795 typcategory = 'D',

542796 typdelim = ',',

543797 typname = "timetz"

544798 }

545799

800+timetzOid :: Oid

801+timetzOid = Oid 1266

802+{-# INLINE timetzOid #-}

803+

546804bit :: TypeInfo

547805bit = Basic {

548− typoid = Oid 1560,

806+ typoid = bitOid,

549807 typcategory = 'V',

550808 typdelim = ',',

551809 typname = "bit"

552810 }

553811

812+bitOid :: Oid

813+bitOid = Oid 1560

814+{-# INLINE bitOid #-}

815+

554816varbit :: TypeInfo

555817varbit = Basic {

556− typoid = Oid 1562,

818+ typoid = varbitOid,

557819 typcategory = 'V',

558820 typdelim = ',',

559821 typname = "varbit"

560822 }

561823

824+varbitOid :: Oid

825+varbitOid = Oid 1562

826+{-# INLINE varbitOid #-}

827+

562828numeric :: TypeInfo

563829numeric = Basic {

564− typoid = Oid 1700,

830+ typoid = numericOid,

565831 typcategory = 'N',

566832 typdelim = ',',

567833 typname = "numeric"

568834 }

569835

836+numericOid :: Oid

837+numericOid = Oid 1700

838+{-# INLINE numericOid #-}

839+

570840refcursor :: TypeInfo

571841refcursor = Basic {

572− typoid = Oid 1790,

842+ typoid = refcursorOid,

573843 typcategory = 'U',

574844 typdelim = ',',

575845 typname = "refcursor"

576846 }

577847

848+refcursorOid :: Oid

849+refcursorOid = Oid 1790

850+{-# INLINE refcursorOid #-}

851+

578852record :: TypeInfo

579853record = Basic {

580− typoid = Oid 2249,

854+ typoid = recordOid,

581855 typcategory = 'P',

582856 typdelim = ',',

583857 typname = "record"

584858 }

585859

860+recordOid :: Oid

861+recordOid = Oid 2249

862+{-# INLINE recordOid #-}

863+

586864void :: TypeInfo

587865void = Basic {

588− typoid = Oid 2278,

866+ typoid = voidOid,

589867 typcategory = 'P',

590868 typdelim = ',',

591869 typname = "void"

592870 }

593871

872+voidOid :: Oid

873+voidOid = Oid 2278

874+{-# INLINE voidOid #-}

875+

594876array_record :: TypeInfo

595877array_record = Array {

596− typoid = Oid 2287,

878+ typoid = array_recordOid,

597879 typcategory = 'P',

598880 typdelim = ',',

599881 typname = "_record",

600882 typelem = record

601883 }

602884

885+array_recordOid :: Oid

886+array_recordOid = Oid 2287

887+{-# INLINE array_recordOid #-}

888+

603889regprocedure :: TypeInfo

604890regprocedure = Basic {

605− typoid = Oid 2202,

891+ typoid = regprocedureOid,

606892 typcategory = 'N',

607893 typdelim = ',',

608894 typname = "regprocedure"

609895 }

610896

897+regprocedureOid :: Oid

898+regprocedureOid = Oid 2202

899+{-# INLINE regprocedureOid #-}

900+

611901regoper :: TypeInfo

612902regoper = Basic {

613− typoid = Oid 2203,

903+ typoid = regoperOid,

614904 typcategory = 'N',

615905 typdelim = ',',

616906 typname = "regoper"

617907 }

618908

909+regoperOid :: Oid

910+regoperOid = Oid 2203

911+{-# INLINE regoperOid #-}

912+

619913regoperator :: TypeInfo

620914regoperator = Basic {

621− typoid = Oid 2204,

915+ typoid = regoperatorOid,

622916 typcategory = 'N',

623917 typdelim = ',',

624918 typname = "regoperator"

625919 }

626920

921+regoperatorOid :: Oid

922+regoperatorOid = Oid 2204

923+{-# INLINE regoperatorOid #-}

924+

627925regclass :: TypeInfo

628926regclass = Basic {

629− typoid = Oid 2205,

927+ typoid = regclassOid,

630928 typcategory = 'N',

631929 typdelim = ',',

632930 typname = "regclass"

633931 }

634932

933+regclassOid :: Oid

934+regclassOid = Oid 2205

935+{-# INLINE regclassOid #-}

936+

635937regtype :: TypeInfo

636938regtype = Basic {

637− typoid = Oid 2206,

939+ typoid = regtypeOid,

638940 typcategory = 'N',

639941 typdelim = ',',

640942 typname = "regtype"

641943 }

642944

945+regtypeOid :: Oid

946+regtypeOid = Oid 2206

947+{-# INLINE regtypeOid #-}

948+

643949uuid :: TypeInfo

644950uuid = Basic {

645− typoid = Oid 2950,

951+ typoid = uuidOid,

646952 typcategory = 'U',

647953 typdelim = ',',

648954 typname = "uuid"

649955 }

650956

957+uuidOid :: Oid

958+uuidOid = Oid 2950

959+{-# INLINE uuidOid #-}

960+

651961json :: TypeInfo

652962json = Basic {

653− typoid = Oid 114,

963+ typoid = jsonOid,

654964 typcategory = 'U',

655965 typdelim = ',',

656966 typname = "json"

657967 }

658968

969+jsonOid :: Oid

970+jsonOid = Oid 114

971+{-# INLINE jsonOid #-}

972+

659973jsonb :: TypeInfo

660974jsonb = Basic {

661− typoid = Oid 3802,

975+ typoid = jsonbOid,

662976 typcategory = 'U',

663977 typdelim = ',',

664978 typname = "jsonb"

665979 }

666980

981+jsonbOid :: Oid

982+jsonbOid = Oid 3802

983+{-# INLINE jsonbOid #-}

984+

667985int2vector :: TypeInfo

668986int2vector = Array {

669− typoid = Oid 22,

987+ typoid = int2vectorOid,

670988 typcategory = 'A',

671989 typdelim = ',',

672990 typname = "int2vector",

673991 typelem = int2

674992 }

675993

994+int2vectorOid :: Oid

995+int2vectorOid = Oid 22

996+{-# INLINE int2vectorOid #-}

997+

676998oidvector :: TypeInfo

677999oidvector = Array {

678− typoid = Oid 30,

1000+ typoid = oidvectorOid,

6791001 typcategory = 'A',

6801002 typdelim = ',',

6811003 typname = "oidvector",

6821004 typelem = oid

6831005 }

6841006

1007+oidvectorOid :: Oid

1008+oidvectorOid = Oid 30

1009+{-# INLINE oidvectorOid #-}

1010+

6851011array_xml :: TypeInfo

6861012array_xml = Array {

687− typoid = Oid 143,

1013+ typoid = array_xmlOid,

6881014 typcategory = 'A',

6891015 typdelim = ',',

6901016 typname = "_xml",

6911017 typelem = xml

6921018 }

6931019

1020+array_xmlOid :: Oid

1021+array_xmlOid = Oid 143

1022+{-# INLINE array_xmlOid #-}

1023+

6941024array_json :: TypeInfo

6951025array_json = Array {

696− typoid = Oid 199,

1026+ typoid = array_jsonOid,

6971027 typcategory = 'A',

6981028 typdelim = ',',

6991029 typname = "_json",

7001030 typelem = json

7011031 }

7021032

1033+array_jsonOid :: Oid

1034+array_jsonOid = Oid 199

1035+{-# INLINE array_jsonOid #-}

1036+

7031037array_line :: TypeInfo

7041038array_line = Array {

705− typoid = Oid 629,

1039+ typoid = array_lineOid,

7061040 typcategory = 'A',

7071041 typdelim = ',',

7081042 typname = "_line",

7091043 typelem = line

7101044 }

7111045

1046+array_lineOid :: Oid

1047+array_lineOid = Oid 629

1048+{-# INLINE array_lineOid #-}

1049+

7121050array_cidr :: TypeInfo

7131051array_cidr = Array {

714− typoid = Oid 651,

1052+ typoid = array_cidrOid,

7151053 typcategory = 'A',

7161054 typdelim = ',',

7171055 typname = "_cidr",

7181056 typelem = cidr

7191057 }

7201058

1059+array_cidrOid :: Oid

1060+array_cidrOid = Oid 651

1061+{-# INLINE array_cidrOid #-}

1062+

7211063array_circle :: TypeInfo

7221064array_circle = Array {

723− typoid = Oid 719,

1065+ typoid = array_circleOid,

7241066 typcategory = 'A',

7251067 typdelim = ',',

7261068 typname = "_circle",

7271069 typelem = circle

7281070 }

7291071

1072+array_circleOid :: Oid

1073+array_circleOid = Oid 719

1074+{-# INLINE array_circleOid #-}

1075+

7301076array_money :: TypeInfo

7311077array_money = Array {

732− typoid = Oid 791,

1078+ typoid = array_moneyOid,

7331079 typcategory = 'A',

7341080 typdelim = ',',

7351081 typname = "_money",

7361082 typelem = money

7371083 }

7381084

1085+array_moneyOid :: Oid

1086+array_moneyOid = Oid 791

1087+{-# INLINE array_moneyOid #-}

1088+

7391089array_bool :: TypeInfo

7401090array_bool = Array {

741− typoid = Oid 1000,

1091+ typoid = array_boolOid,

7421092 typcategory = 'A',

7431093 typdelim = ',',

7441094 typname = "_bool",

7451095 typelem = bool

7461096 }

7471097

1098+array_boolOid :: Oid

1099+array_boolOid = Oid 1000

1100+{-# INLINE array_boolOid #-}

1101+

7481102array_bytea :: TypeInfo

7491103array_bytea = Array {

750− typoid = Oid 1001,

1104+ typoid = array_byteaOid,

7511105 typcategory = 'A',

7521106 typdelim = ',',

7531107 typname = "_bytea",

7541108 typelem = bytea

7551109 }

7561110

1111+array_byteaOid :: Oid

1112+array_byteaOid = Oid 1001

1113+{-# INLINE array_byteaOid #-}

1114+

7571115array_char :: TypeInfo

7581116array_char = Array {

759− typoid = Oid 1002,

1117+ typoid = array_charOid,

7601118 typcategory = 'A',

7611119 typdelim = ',',

7621120 typname = "_char",

7631121 typelem = char

7641122 }

7651123

1124+array_charOid :: Oid

1125+array_charOid = Oid 1002

1126+{-# INLINE array_charOid #-}

1127+

7661128array_name :: TypeInfo

7671129array_name = Array {

768− typoid = Oid 1003,

1130+ typoid = array_nameOid,

7691131 typcategory = 'A',

7701132 typdelim = ',',

7711133 typname = "_name",

7721134 typelem = name

7731135 }

7741136

1137+array_nameOid :: Oid

1138+array_nameOid = Oid 1003

1139+{-# INLINE array_nameOid #-}

1140+

7751141array_int2 :: TypeInfo

7761142array_int2 = Array {

777− typoid = Oid 1005,

1143+ typoid = array_int2Oid,

7781144 typcategory = 'A',

7791145 typdelim = ',',

7801146 typname = "_int2",

7811147 typelem = int2

7821148 }

7831149

1150+array_int2Oid :: Oid

1151+array_int2Oid = Oid 1005

1152+{-# INLINE array_int2Oid #-}

1153+

7841154array_int2vector :: TypeInfo

7851155array_int2vector = Array {

786− typoid = Oid 1006,

1156+ typoid = array_int2vectorOid,

7871157 typcategory = 'A',

7881158 typdelim = ',',

7891159 typname = "_int2vector",

7901160 typelem = int2vector

7911161 }

7921162

1163+array_int2vectorOid :: Oid

1164+array_int2vectorOid = Oid 1006

1165+{-# INLINE array_int2vectorOid #-}

1166+

7931167array_int4 :: TypeInfo

7941168array_int4 = Array {

795− typoid = Oid 1007,

1169+ typoid = array_int4Oid,

7961170 typcategory = 'A',

7971171 typdelim = ',',

7981172 typname = "_int4",

7991173 typelem = int4

8001174 }

8011175

1176+array_int4Oid :: Oid

1177+array_int4Oid = Oid 1007

1178+{-# INLINE array_int4Oid #-}

1179+

8021180array_regproc :: TypeInfo

8031181array_regproc = Array {

804− typoid = Oid 1008,

1182+ typoid = array_regprocOid,

8051183 typcategory = 'A',

8061184 typdelim = ',',

8071185 typname = "_regproc",

8081186 typelem = regproc

8091187 }

8101188

1189+array_regprocOid :: Oid

1190+array_regprocOid = Oid 1008

1191+{-# INLINE array_regprocOid #-}

1192+

8111193array_text :: TypeInfo

8121194array_text = Array {

813− typoid = Oid 1009,

1195+ typoid = array_textOid,

8141196 typcategory = 'A',

8151197 typdelim = ',',

8161198 typname = "_text",

8171199 typelem = text

8181200 }

8191201

1202+array_textOid :: Oid

1203+array_textOid = Oid 1009

1204+{-# INLINE array_textOid #-}

1205+

8201206array_tid :: TypeInfo

8211207array_tid = Array {

822− typoid = Oid 1010,

1208+ typoid = array_tidOid,

8231209 typcategory = 'A',

8241210 typdelim = ',',

8251211 typname = "_tid",

8261212 typelem = tid

8271213 }

8281214

1215+array_tidOid :: Oid

1216+array_tidOid = Oid 1010

1217+{-# INLINE array_tidOid #-}

1218+

8291219array_xid :: TypeInfo

8301220array_xid = Array {

831− typoid = Oid 1011,

1221+ typoid = array_xidOid,

8321222 typcategory = 'A',

8331223 typdelim = ',',

8341224 typname = "_xid",

8351225 typelem = xid

8361226 }

8371227

1228+array_xidOid :: Oid

1229+array_xidOid = Oid 1011

1230+{-# INLINE array_xidOid #-}

1231+

8381232array_cid :: TypeInfo

8391233array_cid = Array {

840− typoid = Oid 1012,

1234+ typoid = array_cidOid,

8411235 typcategory = 'A',

8421236 typdelim = ',',

8431237 typname = "_cid",

8441238 typelem = cid

8451239 }

8461240

1241+array_cidOid :: Oid

1242+array_cidOid = Oid 1012

1243+{-# INLINE array_cidOid #-}

1244+

8471245array_oidvector :: TypeInfo

8481246array_oidvector = Array {

849− typoid = Oid 1013,

1247+ typoid = array_oidvectorOid,

8501248 typcategory = 'A',

8511249 typdelim = ',',

8521250 typname = "_oidvector",

8531251 typelem = oidvector

8541252 }

8551253

1254+array_oidvectorOid :: Oid

1255+array_oidvectorOid = Oid 1013

1256+{-# INLINE array_oidvectorOid #-}

1257+

8561258array_bpchar :: TypeInfo

8571259array_bpchar = Array {

858− typoid = Oid 1014,

1260+ typoid = array_bpcharOid,

8591261 typcategory = 'A',

8601262 typdelim = ',',

8611263 typname = "_bpchar",

8621264 typelem = bpchar

8631265 }

8641266

1267+array_bpcharOid :: Oid

1268+array_bpcharOid = Oid 1014

1269+{-# INLINE array_bpcharOid #-}

1270+

8651271array_varchar :: TypeInfo

8661272array_varchar = Array {

867− typoid = Oid 1015,

1273+ typoid = array_varcharOid,

8681274 typcategory = 'A',

8691275 typdelim = ',',

8701276 typname = "_varchar",

8711277 typelem = varchar

8721278 }

8731279

1280+array_varcharOid :: Oid

1281+array_varcharOid = Oid 1015

1282+{-# INLINE array_varcharOid #-}

1283+

8741284array_int8 :: TypeInfo

8751285array_int8 = Array {

876− typoid = Oid 1016,

1286+ typoid = array_int8Oid,

8771287 typcategory = 'A',

8781288 typdelim = ',',

8791289 typname = "_int8",

8801290 typelem = int8

8811291 }

8821292

1293+array_int8Oid :: Oid

1294+array_int8Oid = Oid 1016

1295+{-# INLINE array_int8Oid #-}

1296+

8831297array_point :: TypeInfo

8841298array_point = Array {

885− typoid = Oid 1017,

1299+ typoid = array_pointOid,

8861300 typcategory = 'A',

8871301 typdelim = ',',

8881302 typname = "_point",

8891303 typelem = point

8901304 }

8911305

1306+array_pointOid :: Oid

1307+array_pointOid = Oid 1017

1308+{-# INLINE array_pointOid #-}

1309+

8921310array_lseg :: TypeInfo

8931311array_lseg = Array {

894− typoid = Oid 1018,

1312+ typoid = array_lsegOid,

8951313 typcategory = 'A',

8961314 typdelim = ',',

8971315 typname = "_lseg",

8981316 typelem = lseg

8991317 }

9001318

1319+array_lsegOid :: Oid

1320+array_lsegOid = Oid 1018

1321+{-# INLINE array_lsegOid #-}

1322+

9011323array_path :: TypeInfo

9021324array_path = Array {

903− typoid = Oid 1019,

1325+ typoid = array_pathOid,

9041326 typcategory = 'A',

9051327 typdelim = ',',

9061328 typname = "_path",

9071329 typelem = path

9081330 }

9091331

1332+array_pathOid :: Oid

1333+array_pathOid = Oid 1019

1334+{-# INLINE array_pathOid #-}

1335+

9101336array_box :: TypeInfo

9111337array_box = Array {

912− typoid = Oid 1020,

1338+ typoid = array_boxOid,

9131339 typcategory = 'A',

9141340 typdelim = ';',

9151341 typname = "_box",

9161342 typelem = box

9171343 }

9181344

1345+array_boxOid :: Oid

1346+array_boxOid = Oid 1020

1347+{-# INLINE array_boxOid #-}

1348+

9191349array_float4 :: TypeInfo

9201350array_float4 = Array {

921− typoid = Oid 1021,

1351+ typoid = array_float4Oid,

9221352 typcategory = 'A',

9231353 typdelim = ',',

9241354 typname = "_float4",

9251355 typelem = float4

9261356 }

9271357

1358+array_float4Oid :: Oid

1359+array_float4Oid = Oid 1021

1360+{-# INLINE array_float4Oid #-}

1361+

9281362array_float8 :: TypeInfo

9291363array_float8 = Array {

930− typoid = Oid 1022,

1364+ typoid = array_float8Oid,

9311365 typcategory = 'A',

9321366 typdelim = ',',

9331367 typname = "_float8",

9341368 typelem = float8

9351369 }

9361370

1371+array_float8Oid :: Oid

1372+array_float8Oid = Oid 1022

1373+{-# INLINE array_float8Oid #-}

1374+

9371375array_polygon :: TypeInfo

9381376array_polygon = Array {

939− typoid = Oid 1027,

1377+ typoid = array_polygonOid,

9401378 typcategory = 'A',

9411379 typdelim = ',',

9421380 typname = "_polygon",

9431381 typelem = polygon

9441382 }

9451383

1384+array_polygonOid :: Oid

1385+array_polygonOid = Oid 1027

1386+{-# INLINE array_polygonOid #-}

1387+

9461388array_oid :: TypeInfo

9471389array_oid = Array {

948− typoid = Oid 1028,

1390+ typoid = array_oidOid,

9491391 typcategory = 'A',

9501392 typdelim = ',',

9511393 typname = "_oid",

9521394 typelem = oid

9531395 }

9541396

1397+array_oidOid :: Oid

1398+array_oidOid = Oid 1028

1399+{-# INLINE array_oidOid #-}

1400+

9551401array_macaddr :: TypeInfo

9561402array_macaddr = Array {

957− typoid = Oid 1040,

1403+ typoid = array_macaddrOid,

9581404 typcategory = 'A',

9591405 typdelim = ',',

9601406 typname = "_macaddr",

9611407 typelem = macaddr

9621408 }

9631409

1410+array_macaddrOid :: Oid

1411+array_macaddrOid = Oid 1040

1412+{-# INLINE array_macaddrOid #-}

1413+

9641414array_inet :: TypeInfo

9651415array_inet = Array {

966− typoid = Oid 1041,

1416+ typoid = array_inetOid,

9671417 typcategory = 'A',

9681418 typdelim = ',',

9691419 typname = "_inet",

9701420 typelem = inet

9711421 }

9721422

1423+array_inetOid :: Oid

1424+array_inetOid = Oid 1041

1425+{-# INLINE array_inetOid #-}

1426+

9731427array_timestamp :: TypeInfo

9741428array_timestamp = Array {

975− typoid = Oid 1115,

1429+ typoid = array_timestampOid,

9761430 typcategory = 'A',

9771431 typdelim = ',',

9781432 typname = "_timestamp",

9791433 typelem = timestamp

9801434 }

9811435

1436+array_timestampOid :: Oid

1437+array_timestampOid = Oid 1115

1438+{-# INLINE array_timestampOid #-}

1439+

9821440array_date :: TypeInfo

9831441array_date = Array {

984− typoid = Oid 1182,

1442+ typoid = array_dateOid,

9851443 typcategory = 'A',

9861444 typdelim = ',',

9871445 typname = "_date",

9881446 typelem = date

9891447 }

9901448

1449+array_dateOid :: Oid

1450+array_dateOid = Oid 1182

1451+{-# INLINE array_dateOid #-}

1452+

9911453array_time :: TypeInfo

9921454array_time = Array {

993− typoid = Oid 1183,

1455+ typoid = array_timeOid,

9941456 typcategory = 'A',

9951457 typdelim = ',',

9961458 typname = "_time",

9971459 typelem = time

9981460 }

9991461

1462+array_timeOid :: Oid

1463+array_timeOid = Oid 1183

1464+{-# INLINE array_timeOid #-}

1465+

10001466array_timestamptz :: TypeInfo

10011467array_timestamptz = Array {

1002− typoid = Oid 1185,

1468+ typoid = array_timestamptzOid,

10031469 typcategory = 'A',

10041470 typdelim = ',',

10051471 typname = "_timestamptz",

10061472 typelem = timestamptz

10071473 }

10081474

1475+array_timestamptzOid :: Oid

1476+array_timestamptzOid = Oid 1185

1477+{-# INLINE array_timestamptzOid #-}

1478+

10091479array_interval :: TypeInfo

10101480array_interval = Array {

1011− typoid = Oid 1187,

1481+ typoid = array_intervalOid,

10121482 typcategory = 'A',

10131483 typdelim = ',',

10141484 typname = "_interval",

10151485 typelem = interval

10161486 }

10171487

1488+array_intervalOid :: Oid

1489+array_intervalOid = Oid 1187

1490+{-# INLINE array_intervalOid #-}

1491+

10181492array_numeric :: TypeInfo

10191493array_numeric = Array {

1020− typoid = Oid 1231,

1494+ typoid = array_numericOid,

10211495 typcategory = 'A',

10221496 typdelim = ',',

10231497 typname = "_numeric",

10241498 typelem = numeric

10251499 }

10261500

1501+array_numericOid :: Oid

1502+array_numericOid = Oid 1231

1503+{-# INLINE array_numericOid #-}

1504+

10271505array_timetz :: TypeInfo

10281506array_timetz = Array {

1029− typoid = Oid 1270,

1507+ typoid = array_timetzOid,

10301508 typcategory = 'A',

10311509 typdelim = ',',

10321510 typname = "_timetz",

10331511 typelem = timetz

10341512 }

10351513

1514+array_timetzOid :: Oid

1515+array_timetzOid = Oid 1270

1516+{-# INLINE array_timetzOid #-}

1517+

10361518array_bit :: TypeInfo

10371519array_bit = Array {

1038− typoid = Oid 1561,

1520+ typoid = array_bitOid,

10391521 typcategory = 'A',

10401522 typdelim = ',',

10411523 typname = "_bit",

10421524 typelem = bit

10431525 }

10441526

1527+array_bitOid :: Oid

1528+array_bitOid = Oid 1561

1529+{-# INLINE array_bitOid #-}

1530+

10451531array_varbit :: TypeInfo

10461532array_varbit = Array {

1047− typoid = Oid 1563,

1533+ typoid = array_varbitOid,

10481534 typcategory = 'A',

10491535 typdelim = ',',

10501536 typname = "_varbit",

10511537 typelem = varbit

10521538 }

10531539

1540+array_varbitOid :: Oid

1541+array_varbitOid = Oid 1563

1542+{-# INLINE array_varbitOid #-}

1543+

10541544array_refcursor :: TypeInfo

10551545array_refcursor = Array {

1056− typoid = Oid 2201,

1546+ typoid = array_refcursorOid,

10571547 typcategory = 'A',

10581548 typdelim = ',',

10591549 typname = "_refcursor",

10601550 typelem = refcursor

10611551 }

10621552

1553+array_refcursorOid :: Oid

1554+array_refcursorOid = Oid 2201

1555+{-# INLINE array_refcursorOid #-}

1556+

10631557array_regprocedure :: TypeInfo

10641558array_regprocedure = Array {

1065− typoid = Oid 2207,

1559+ typoid = array_regprocedureOid,

10661560 typcategory = 'A',

10671561 typdelim = ',',

10681562 typname = "_regprocedure",

10691563 typelem = regprocedure

10701564 }

10711565

1566+array_regprocedureOid :: Oid

1567+array_regprocedureOid = Oid 2207

1568+{-# INLINE array_regprocedureOid #-}

1569+

10721570array_regoper :: TypeInfo

10731571array_regoper = Array {

1074− typoid = Oid 2208,

1572+ typoid = array_regoperOid,

10751573 typcategory = 'A',

10761574 typdelim = ',',

10771575 typname = "_regoper",

10781576 typelem = regoper

10791577 }

10801578

1579+array_regoperOid :: Oid

1580+array_regoperOid = Oid 2208

1581+{-# INLINE array_regoperOid #-}

1582+

10811583array_regoperator :: TypeInfo

10821584array_regoperator = Array {

1083− typoid = Oid 2209,

1585+ typoid = array_regoperatorOid,

10841586 typcategory = 'A',

10851587 typdelim = ',',

10861588 typname = "_regoperator",

10871589 typelem = regoperator

10881590 }

10891591

1592+array_regoperatorOid :: Oid

1593+array_regoperatorOid = Oid 2209

1594+{-# INLINE array_regoperatorOid #-}

1595+

10901596array_regclass :: TypeInfo

10911597array_regclass = Array {

1092− typoid = Oid 2210,

1598+ typoid = array_regclassOid,

10931599 typcategory = 'A',

10941600 typdelim = ',',

10951601 typname = "_regclass",

10961602 typelem = regclass

10971603 }

10981604

1605+array_regclassOid :: Oid

1606+array_regclassOid = Oid 2210

1607+{-# INLINE array_regclassOid #-}

1608+

10991609array_regtype :: TypeInfo

11001610array_regtype = Array {

1101− typoid = Oid 2211,

1611+ typoid = array_regtypeOid,

11021612 typcategory = 'A',

11031613 typdelim = ',',

11041614 typname = "_regtype",

11051615 typelem = regtype

11061616 }

11071617

1618+array_regtypeOid :: Oid

1619+array_regtypeOid = Oid 2211

1620+{-# INLINE array_regtypeOid #-}

1621+

11081622array_uuid :: TypeInfo

11091623array_uuid = Array {

1110− typoid = Oid 2951,

1624+ typoid = array_uuidOid,

11111625 typcategory = 'A',

11121626 typdelim = ',',

11131627 typname = "_uuid",

11141628 typelem = uuid

11151629 }

11161630

1631+array_uuidOid :: Oid

1632+array_uuidOid = Oid 2951

1633+{-# INLINE array_uuidOid #-}

1634+

11171635array_jsonb :: TypeInfo

11181636array_jsonb = Array {

1119− typoid = Oid 3807,

1637+ typoid = array_jsonbOid,

11201638 typcategory = 'A',

11211639 typdelim = ',',

11221640 typname = "_jsonb",

11231641 typelem = jsonb

11241642 }

11251643

1644+array_jsonbOid :: Oid

1645+array_jsonbOid = Oid 3807

1646+{-# INLINE array_jsonbOid #-}

1647+

11261648int4range :: TypeInfo

11271649int4range = Range {

1128− typoid = Oid 3904,

1650+ typoid = int4rangeOid,

11291651 typcategory = 'R',

11301652 typdelim = ',',

11311653 typname = "int4range",

11321654 rngsubtype = int4

11331655 }

11341656

1657+int4rangeOid :: Oid

1658+int4rangeOid = Oid 3904

1659+{-# INLINE int4rangeOid #-}

1660+

11351661_int4range :: TypeInfo

11361662_int4range = Array {

1137− typoid = Oid 3905,

1663+ typoid = _int4rangeOid,

11381664 typcategory = 'A',

11391665 typdelim = ',',

11401666 typname = "_int4range",

11411667 typelem = int4range

11421668 }

11431669

1670+_int4rangeOid :: Oid

1671+_int4rangeOid = Oid 3905

1672+{-# INLINE _int4rangeOid #-}

1673+

11441674numrange :: TypeInfo

11451675numrange = Range {

1146− typoid = Oid 3906,

1676+ typoid = numrangeOid,

11471677 typcategory = 'R',

11481678 typdelim = ',',

11491679 typname = "numrange",

11501680 rngsubtype = numeric

11511681 }

11521682

1683+numrangeOid :: Oid

1684+numrangeOid = Oid 3906

1685+{-# INLINE numrangeOid #-}

1686+

11531687_numrange :: TypeInfo

11541688_numrange = Array {

1155− typoid = Oid 3907,

1689+ typoid = _numrangeOid,

11561690 typcategory = 'A',

11571691 typdelim = ',',

11581692 typname = "_numrange",

11591693 typelem = numrange

11601694 }

11611695

1696+_numrangeOid :: Oid

1697+_numrangeOid = Oid 3907

1698+{-# INLINE _numrangeOid #-}

1699+

11621700tsrange :: TypeInfo

11631701tsrange = Range {

1164− typoid = Oid 3908,

1702+ typoid = tsrangeOid,

11651703 typcategory = 'R',

11661704 typdelim = ',',

11671705 typname = "tsrange",

11681706 rngsubtype = timestamp

11691707 }

11701708

1709+tsrangeOid :: Oid

1710+tsrangeOid = Oid 3908

1711+{-# INLINE tsrangeOid #-}

1712+

11711713_tsrange :: TypeInfo

11721714_tsrange = Array {

1173− typoid = Oid 3909,

1715+ typoid = _tsrangeOid,

11741716 typcategory = 'A',

11751717 typdelim = ',',

11761718 typname = "_tsrange",

11771719 typelem = tsrange

11781720 }

11791721

1722+_tsrangeOid :: Oid

1723+_tsrangeOid = Oid 3909

1724+{-# INLINE _tsrangeOid #-}

1725+

11801726tstzrange :: TypeInfo

11811727tstzrange = Range {

1182− typoid = Oid 3910,

1728+ typoid = tstzrangeOid,

11831729 typcategory = 'R',

11841730 typdelim = ',',

11851731 typname = "tstzrange",

11861732 rngsubtype = timestamptz

11871733 }

11881734

1735+tstzrangeOid :: Oid

1736+tstzrangeOid = Oid 3910

1737+{-# INLINE tstzrangeOid #-}

1738+

11891739_tstzrange :: TypeInfo

11901740_tstzrange = Array {

1191− typoid = Oid 3911,

1741+ typoid = _tstzrangeOid,

11921742 typcategory = 'A',

11931743 typdelim = ',',

11941744 typname = "_tstzrange",

11951745 typelem = tstzrange

11961746 }

11971747

1748+_tstzrangeOid :: Oid

1749+_tstzrangeOid = Oid 3911

1750+{-# INLINE _tstzrangeOid #-}

1751+

11981752daterange :: TypeInfo

11991753daterange = Range {

1200− typoid = Oid 3912,

1754+ typoid = daterangeOid,

12011755 typcategory = 'R',

12021756 typdelim = ',',

12031757 typname = "daterange",

12041758 rngsubtype = date

12051759 }

12061760

1761+daterangeOid :: Oid

1762+daterangeOid = Oid 3912

1763+{-# INLINE daterangeOid #-}

1764+

12071765_daterange :: TypeInfo

12081766_daterange = Array {

1209− typoid = Oid 3913,

1767+ typoid = _daterangeOid,

12101768 typcategory = 'A',

12111769 typdelim = ',',

12121770 typname = "_daterange",

12131771 typelem = daterange

12141772 }

12151773

1774+_daterangeOid :: Oid

1775+_daterangeOid = Oid 3913

1776+{-# INLINE _daterangeOid #-}

1777+

12161778int8range :: TypeInfo

12171779int8range = Range {

1218− typoid = Oid 3926,

1780+ typoid = int8rangeOid,

12191781 typcategory = 'R',

12201782 typdelim = ',',

12211783 typname = "int8range",

12221784 rngsubtype = int8

12231785 }

12241786

1787+int8rangeOid :: Oid

1788+int8rangeOid = Oid 3926

1789+{-# INLINE int8rangeOid #-}

1790+

12251791_int8range :: TypeInfo

12261792_int8range = Array {

1227− typoid = Oid 3927,

1793+ typoid = _int8rangeOid,

12281794 typcategory = 'A',

12291795 typdelim = ',',

12301796 typname = "_int8range",

12311797 typelem = int8range

12321798 }

1799+

1800+_int8rangeOid :: Oid

1801+_int8rangeOid = Oid 3927

1802+{-# INLINE _int8rangeOid #-}

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

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

5050data Null = Null

5151 deriving (Read, Show, Typeable)

5252

53−instance Eq Null where

54− _ == _ = False

55− _ /= _ = False

56−

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

5854data Default = Default

5955 deriving (Read, Show, Typeable)

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

9793

9894instance Monoid Query where

9995 mempty = Query B.empty

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

101− mappend = (<>)

102−#endif

10396

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

10598-- single \"@?@\" character with a parenthesized list of rendered

test/Exception.hsnew file+70

@@ -0,0 +1,70 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

5+module Exception (testExceptions) where

7+import Database.PostgreSQL.Simple

8+import Test.Tasty.HUnit (Assertion, assertBool)

9+import Common (TestEnv)

10+import Control.Exception (Exception (..), SomeException)

11+import Data.Maybe (isJust)

12+import Data.Either (isLeft)

13+import Control.Exception (throwIO, try)

14+

15+testExceptions :: TestEnv -> Assertion

16+testExceptions _ = do

17+ let sqlError = SqlError

18+ { sqlState = ""

19+ , sqlExecStatus = FatalError

20+ , sqlErrorMsg = ""

21+ , sqlErrorDetail = ""

22+ , sqlErrorHint = ""

23+ }

24+ let sqlEx :: SomeException = toException sqlError

25+ assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)

26+ assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)

27+ eSqlError :: Either SqlError () <- try $ throwIO sqlEx

28+ assertBool "Can catch SqlError" $ isLeft eSqlError

29+ eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx

30+ assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx

31+

32+ let formatError = FormatError

33+ { fmtMessage = ""

34+ , fmtQuery = ""

35+ , fmtParams = []

36+ }

37+ let formatEx :: SomeException = toException formatError

38+ assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)

39+ assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)

40+ eFormatError :: Either FormatError () <- try $ throwIO formatEx

41+ assertBool "Can catch FormatError" $ isLeft eFormatError

42+ eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx

43+ assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx

44+

45+ let queryError = QueryError

46+ { qeMessage = ""

47+ , qeQuery = ""

48+ }

49+ let queryEx :: SomeException = toException queryError

50+ assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)

51+ assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)

52+ eQueryError :: Either QueryError () <- try $ throwIO queryEx

53+ assertBool "Can catch QueryError" $ isLeft eQueryError

54+ eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx

55+ assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx

56+

57+ let resultError = Incompatible

58+ { errSQLType = ""

59+ , errSQLTableOid = Nothing

60+ , errSQLField = ""

61+ , errHaskellType = ""

62+ , errMessage = ""

63+ }

64+ let resultEx :: SomeException = toException resultError

65+ assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)

66+ assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)

67+ eResultEx :: Either ResultError () <- try $ throwIO resultEx

68+ assertBool "Can catch ResultError" $ isLeft eResultEx

69+ eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx

70+ assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx

test/Inspection.hsnew file+79

@@ -0,0 +1,79 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE TemplateHaskell #-}

3+{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-module-prefixes -dsuppress-type-signatures #-}

4+-- {-# OPTIONS_GHC -dsuppress-uniques #-}

5+{-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin #-}

6+module Main where

8+import Test.Inspection

9+import Test.Tasty

10+import Test.Tasty.HUnit

11+

12+import qualified Database.PostgreSQL.LibPQ as PQ

13+import Database.PostgreSQL.Simple.FromField

14+import Database.PostgreSQL.Simple.TypeInfo as TI

15+import Database.PostgreSQL.Simple.TypeInfo.Macro

16+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI

17+

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

19+-- Inspection tests

20+-------------------------------------------------------------------------------

21+

22+-- # doesn't work :(

23+#define TH_MKCOMPATS3(a,b,c) $(mkCompats [TI.a,TI.b,TI.c])

24+#define IN_MKCOMPATS3(a,b,c) (eq TI.a \/ eq TI.b \/ eq TI.c)

25+

26+#define TH_INLINETYPOID(n) eq $(inlineTypoid TI.n)

27+#define IN_INLINETYPOID(n) eq TI.n

28+

29+-- eta-expansion is required

30+lhs01, rhs01 :: PQ.Oid -> Bool

31+lhs01 = TH_MKCOMPATS3(name,text,char)

32+rhs01 = IN_MKCOMPATS3(nameOid,textOid,charOid)

33+

34+lhs02, rhs02 :: PQ.Oid -> Bool

35+lhs02 = TH_INLINETYPOID(name)

36+rhs02 = IN_INLINETYPOID(nameOid)

37+

38+eq :: PQ.Oid -> PQ.Oid -> Bool

39+eq = (==)

40+{-# INLINE eq #-}

41+

42+infixr 2 \/

43+(\/) :: (PQ.Oid -> Bool)

44+ -> (PQ.Oid -> Bool)

45+ -> (PQ.Oid -> Bool)

46+f \/ g = \x -> f x || g x

47+{-# INLINE (\/) #-}

48+

49+inspectionTests :: TestTree

50+inspectionTests = testGroup "inspection"

51+ [ testCase "mkCompats" $

52+ assertSuccess $(inspectTest $ 'lhs01 === 'rhs01)

53+

54+ -- byteaOid isn't inlined?

55+ , testCase "inlineTypoid" $

56+#if __GLASGOW_HASKELL__ >= 808

57+ assertSuccess

58+#else

59+ assertFailure'

60+#endif

61+ $(inspectTest $ 'lhs02 ==- 'rhs02)

62+ ]

63+

64+assertSuccess :: Result -> IO ()

65+assertSuccess (Success _) = return ()

66+assertSuccess (Failure err) = assertFailure err

67+

68+assertFailure' :: Result -> IO ()

69+assertFailure' (Success err) = assertFailure err

70+assertFailure' (Failure _) = return ()

71+

72+-------------------------------------------------------------------------------

73+-- Main

74+-------------------------------------------------------------------------------

75+

76+main :: IO ()

77+main = defaultMain $ testGroup "tests"

78+ [ inspectionTests

79+ ]

test/Interval.hsnew file+176

@@ -0,0 +1,176 @@

1+{-# LANGUAGE QuasiQuotes #-}

3+{-

5+Testing strategies:

7+fromString . toString == id ** Todo?

9+toString . fromString == almost id ** Todo?

10+

11+postgresql -> haskell -> postgresql * Done

12+

13+haskell -> postgresql -> haskell ** Todo?

14+

15+But still, what we really want to establish is that the two values

16+correspond; for example, a conversion that consistently added hour

17+when printed to a string and subtracted an hour when parsed from string

18+would still pass these tests.

19+

20+

21+Right now, we are checking that 1400+ timestamps in the range of 1860 to

22+2060 round trip from postgresql to haskell and back in 5 different timezones.

23+In addition to UTC, the four timezones were selected so that 2 have a positive

24+offset, and 2 have a negative offset, and that 2 have an offset of a

25+whole number of hours, while the other two do not.

26+

27+It may be worth adding a few more timezones to ensure better test coverage.

28+

29+We are checking a handful of selected timestamps to ensure we hit

30+various corner-cases in the code, in addition to 1400 timestamps randomly

31+generated with granularity of seconds down to microseconds in powers of ten.

32+

33+-}

34+

35+module Interval (testInterval) where

36+

37+import Common

38+import Control.Monad(forM_, replicateM_)

39+import Data.Time.Compat

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

41+import Data.ByteString(ByteString)

42+import Database.PostgreSQL.Simple.SqlQQ

43+

44+data IntervalTestCase = IntervalTestCase

45+ { label :: String

46+ , inputMonths :: Integer

47+ , inputSeconds :: NominalDiffTime

48+ , asText :: String

49+ }

50+ deriving (Eq, Show)

51+

52+testInterval :: TestEnv -> Assertion

53+testInterval env@TestEnv{..} = do

54+

55+ initializeTable env

56+

57+ let milliseconds = 0.001

58+ seconds = 1

59+ minutes = 60 * seconds

60+ hours = 60 * minutes

61+ days = 24 * hours

62+ weeks = 7 * days

63+ months = 1

64+ years = 12 * months

65+

66+ mapM (checkRoundTrip env)

67+ [ IntervalTestCase

68+ { label = "zero"

69+ , inputMonths = 0

70+ , inputSeconds = 0

71+ , asText = "PT0"

72+ }

73+ , IntervalTestCase

74+ { label = "1 year"

75+ , inputMonths = 1 * years

76+ , inputSeconds = 0

77+ , asText = "P1Y"

78+ }

79+ , IntervalTestCase

80+ { label = "2 months"

81+ , inputMonths = 2 * months

82+ , inputSeconds = 0

83+ , asText = "P2M"

84+ }

85+ , IntervalTestCase

86+ { label = "3 weeks"

87+ , inputMonths = 0

88+ , inputSeconds = 3 * weeks

89+ , asText = "P3W"

90+ }

91+ , IntervalTestCase

92+ { label = "4 days"

93+ , inputMonths = 0

94+ , inputSeconds = 4 * days

95+ , asText = "P4D"

96+ }

97+ , IntervalTestCase

98+ { label = "5 hours"

99+ , inputMonths = 0

100+ , inputSeconds = 5 * hours

101+ , asText = "PT5H"

102+ }

103+ , IntervalTestCase

104+ { label = "6 minutes"

105+ , inputMonths = 0

106+ , inputSeconds = 6 * minutes

107+ , asText = "PT6M"

108+ }

109+ , IntervalTestCase

110+ { label = "7 seconds"

111+ , inputMonths = 0

112+ , inputSeconds = 7 * seconds

113+ , asText = "PT7S"

114+ }

115+ , IntervalTestCase

116+ { label = "8 milliseconds"

117+ , inputMonths = 0

118+ , inputSeconds = 8 * milliseconds

119+ , asText = "PT0.008S"

120+ }

121+ , IntervalTestCase

122+ { label = "combination of intervals (day-size or bigger)"

123+ , inputMonths = 2 * years + 4 * months

124+ , inputSeconds = 3 * weeks + 5 * days

125+ , asText = "P2Y4M3W5D"

126+ }

127+ , IntervalTestCase

128+ { label = "combination of intervals (smaller than day-size)"

129+ , inputMonths = 0

130+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

131+ , asText = "PT18H56M23.563S"

132+ }

133+ , IntervalTestCase

134+ { label = "full combination of intervals"

135+ , inputMonths = 2 * years + 4 * months

136+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

137+ , asText = "P2Y4M3W5DT18H56M23.563S"

138+ }

139+ ]

140+

141+ return ()

142+

143+initializeTable :: TestEnv -> IO ()

144+initializeTable TestEnv{..} = withTransaction conn $ do

145+ execute_ conn

146+ [sql| CREATE TEMPORARY TABLE testinterval

147+ ( id serial, sample interval, PRIMARY KEY(id) ) |]

148+

149+ return ()

150+

151+checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()

152+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do

153+

154+ let input = CalendarDiffTime

155+ { ctMonths = inputMonths

156+ , ctTime = inputSeconds

157+ }

158+

159+ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|

160+ INSERT INTO testinterval (sample)

161+ VALUES (?)

162+ RETURNING id, sample

163+ |] (Only input)

164+

165+ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $

166+ output == input

167+

168+ [(Only isExpectedIso)] <- query conn [sql|

169+ SELECT sample = (?)::interval

170+ FROM testinterval

171+ WHERE id = ?

172+ |] (asText, returnedId)

173+

174+ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")

175+ isExpectedIso

176+

test/Main.hs+179−32

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

33{-# LANGUAGE DeriveDataTypeable #-}

44{-# LANGUAGE DoAndIfThenElse #-}

55{-# LANGUAGE ScopedTypeVariables #-}

6+#if __GLASGOW_HASKELL__ >= 806

7+{-# LANGUAGE DerivingStrategies #-}

8+{-# LANGUAGE DerivingVia #-}

9+{-# LANGUAGE DeriveAnyClass #-}

10+#endif

11+module Main (main) where

12+

613import Common

14+import Database.PostgreSQL.Simple.Copy

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

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

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

917import Database.PostgreSQL.Simple.HStore

10−import Database.PostgreSQL.Simple.Copy

18+import Database.PostgreSQL.Simple.Newtypes

19+import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)

20+import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))

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

1222

1323import Control.Applicative

1424import Control.Exception as E

1525import Control.Monad

1626import Data.Char

17−import Data.List (sort)

27+import Data.Foldable (toList)

28+import Data.List (concat, sort)

1829import Data.IORef

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

31+import Data.String (fromString)

1932import Data.Typeable

2033import GHC.Generics (Generic)

2134

2235import Data.Aeson

2336import Data.ByteString (ByteString)

2437import qualified Data.ByteString as B

38+import qualified Data.ByteString.Char8 as BS8

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

2640import Data.CaseInsensitive (CI)

2741import qualified Data.CaseInsensitive as CI

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

3246import qualified Data.Vector as V

3347import System.FilePath

3448import System.Timeout(timeout)

35−import Data.Time(getCurrentTime, diffUTCTime)

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

50+import System.Environment (getEnvironment)

3651

3752import Test.Tasty

3853import Test.Tasty.Golden

3954import Notify

4055import Serializable

4156import Time

57+import Interval

58+import Exception (testExceptions)

4259

4360tests :: TestEnv -> TestTree

4461tests env = testGroup "tests"

4562 $ map ($ env)

4663 [ testBytea

47− , testCase "ExecuteMany" . testExecuteMany

48− , testCase "Fold" . testFold

49− , testCase "Notify" . testNotify

50− , testCase "Serializable" . testSerializable

51− , testCase "Time" . testTime

52− , testCase "Array" . testArray

53− , testCase "Array of nullables" . testNullableArray

54− , testCase "HStore" . testHStore

55− , testCase "citext" . testCIText

56− , testCase "JSON" . testJSON

57− , testCase "Savepoint" . testSavepoint

58− , testCase "Unicode" . testUnicode

59− , testCase "Values" . testValues

60− , testCase "Copy" . testCopy

64+ , testCase "ExecuteMany" . testExecuteMany

65+ , testCase "Fold" . testFold

66+ , testCase "Notify" . testNotify

67+ , testCase "Serializable" . testSerializable

68+ , testCase "Time" . testTime

69+ , testCase "Interval" . testInterval

70+ , testCase "Array" . testArray

71+ , testCase "Array of nullables" . testNullableArray

72+ , testCase "HStore" . testHStore

73+ , testCase "citext" . testCIText

74+ , testCase "JSON" . testJSON

75+ , testCase "Aeson newtype" . testAeson

76+ , testCase "DerivingVia" . testDerivingVia

77+ , testCase "Question mark escape" . testQM

78+ , testCase "Savepoint" . testSavepoint

79+ , testCase "Unicode" . testUnicode

80+ , testCase "Values" . testValues

81+ , testCase "Copy" . testCopy

6182 , testCopyFailures

62− , testCase "Double" . testDouble

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

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

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

66− , testCase "Timeout" . testTimeout

83+ , testCase "Double" . testDouble

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

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

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

87+ , testCase "Timeout" . testTimeout

88+ , testCase "Exceptions" . testExceptions

6789 ]

6890

6991testBytea :: TestEnv -> TestTree

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

117139 xs <- readIORef ref

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

119141 xs <- readIORef ref

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

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

121143

122144 -- Make sure fold propagates our exception.

123145 ref <- newIORef []

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

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

235257 [js] @?= js'

236258

259+testAeson :: TestEnv -> Assertion

260+testAeson TestEnv{..} = do

261+ roundTrip (Map.fromList [] :: Map Text Text)

262+ roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)

263+ roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)

264+ roundTrip (V.fromList [1,2,3,4,5::Int])

265+ roundTrip ("foo" :: Text)

266+ roundTrip (42 :: Int)

267+ where

268+ roundTrip :: (Eq a, Show a, Typeable a, ToJSON a, FromJSON a)=> a -> Assertion

269+ roundTrip x = do

270+ y <- query conn "SELECT ?::json" (Only (Aeson x))

271+ [Only (Aeson x)] @?= y

272+

273+testDerivingVia :: TestEnv -> Assertion

274+testDerivingVia TestEnv{..} = do

275+#if __GLASGOW_HASKELL__ <806

276+ return ()

277+#else

278+ roundTrip $ DerivingVia1 42 "Meaning of Life"

279+ where

280+ roundTrip :: (Eq a, Show a, Typeable a, ToField a, FromField a)=> a -> Assertion

281+ roundTrip x = do

282+ y <- query conn "SELECT ?::json" (Only x)

283+ [Only x] @?= y

284+

285+data DerivingVia1 = DerivingVia1 Int String

286+ deriving stock (Eq, Show, Generic)

287+ deriving anyclass (FromJSON, ToJSON)

288+ deriving (ToField, FromField) via Aeson DerivingVia1

289+

290+#endif

291+

292+

293+testQM :: TestEnv -> Assertion

294+testQM TestEnv{..} = do

295+ -- Just test on a single string

296+ let testQuery' b = "testing for ?" <> b <> " and making sure "

297+ testQueryDoubleQM = testQuery' "?"

298+ testQueryRest = "? is substituted"

299+ testQuery = fromString $ testQueryDoubleQM <> testQueryRest

300+ -- expect the entire first part with double QMs replaced with literal '?'

301+ expected = (fromString $ testQuery' "", fromString testQueryRest)

302+ tried = breakOnSingleQuestionMark testQuery

303+ errMsg = concat

304+ [ "Failed to break on single question mark exclusively:\n"

305+ , "expected: ", show expected

306+ , "result: ", show tried

307+ ]

308+ assertBool errMsg $ tried == expected

309+

310+ -- Let's also test the question mark operators in action

311+ -- ? -> Does the string exist as a top-level key within the JSON value?

312+ positiveQuery "SELECT ?::jsonb ?? ?" (testObj, "foo" :: Text)

313+ negativeQuery "SELECT ?::jsonb ?? ?" (testObj, "baz" :: Text)

314+ negativeQuery "SELECT ?::jsonb ?? ?" (toJSON numArray, "1" :: Text)

315+ -- ?| -> Do any of these array strings exist as top-level keys?

316+ positiveQuery "SELECT ?::jsonb ??| ?" (testObj, PGArray ["nope","bar","6" :: Text])

317+ negativeQuery "SELECT ?::jsonb ??| ?" (testObj, PGArray ["nope","6" :: Text])

318+ negativeQuery "SELECT ?::jsonb ??| ?" (toJSON numArray, PGArray ["1","2","6" :: Text])

319+ -- ?& -> Do all of these array strings exist as top-level keys?

320+ positiveQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar","quux" :: Text])

321+ positiveQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar" :: Text])

322+ negativeQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar","baz" :: Text])

323+ negativeQuery "SELECT ?::jsonb ??& ?" (toJSON numArray, PGArray ["1","2","3","4","5" :: Text])

324+ -- Format error for 2 question marks, not 4

325+ True <- expectError (isFormatError 2) $

326+ (query conn "SELECT ?::jsonb ?? ?" $ Only testObj :: IO [Only Bool])

327+ return ()

328+ where positiveQuery :: ToRow a => Query -> a -> Assertion

329+ positiveQuery = boolQuery True

330+ negativeQuery :: ToRow a => Query -> a -> Assertion

331+ negativeQuery = boolQuery False

332+ numArray :: [Int]

333+ numArray = [1,2,3,4,5]

334+ boolQuery :: ToRow a => Bool -> Query -> a -> Assertion

335+ boolQuery b t x = do

336+ a <- query conn t x

337+ [Only b] @?= a

338+ testObj = toJSON (Map.fromList [("foo",toJSON (1 :: Int))

339+ ,("bar",String "baz")

340+ ,("quux",toJSON [1 :: Int,2,3,4,5])] :: Map Text Value

341+ )

342+

237343testSavepoint :: TestEnv -> Assertion

238344testSavepoint TestEnv{..} = do

239345 True <- expectError ST.isNoActiveTransactionError $

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

341447 -- so that we can issue more queries:

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

343449 x @?= 4

450+ -- foldCopyData

451+ copy_ conn "COPY copy_test TO STDOUT (FORMAT CSV)"

452+ (acc, count) <- foldCopyData conn

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

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

455+ []

456+ sort acc @?= sort copyRows

457+ count @?= 2

344458 where

345459 copyRows = ["1,foo\n"

346460 ,"2,bar\n"]

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

360474

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

362476goldenTest testName =

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

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

364478 where

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

366480 fileName = map normalize testName

367481 normalize c | not (isAlpha c) = '-'

368482 | otherwise = c

483+ diff ref new = ["diff", "-u", ref, new]

369484

370485-- | Test that we provide a sensible error message on failure

371486testCopyUniqueConstraintError :: TestEnv -> TestTree

@@ -478,24 +593,56 @@ isUniqueViolation SqlError{..} = sqlState == "23505"

478593isSyntaxError :: SqlError -> Bool

479594isSyntaxError SqlError{..} = sqlState == "42601"

480595

596+isFormatError :: Int -> FormatError -> Bool

597+isFormatError i FormatError{..}

598+ | null fmtMessage = False

599+ | otherwise = fmtMessage == concat [ show i

600+ , " single '?' characters, but "

601+ , show (length fmtParams)

602+ , " parameters"

603+ ]

481604------------------------------------------------------------------------

482605

483606-- | Action for connecting to the database that will be used for testing.

484607--

485608-- Note that some tests, such as Notify, use multiple connections, and assume

486609-- that 'testConnect' connects to the same database every time it is called.

487−testConnect :: IO Connection

488−testConnect = connectPostgreSQL ""

610+withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

611+withTestEnv connstr cb =

612+ withConn $ \conn -> do

613+ -- currently required for interval to work.

614+ -- we also test that this doesn't interfere with anything else

615+ execute_ conn "SET intervalstyle TO 'iso_8601'"

489616

490−withTestEnv :: (TestEnv -> IO a) -> IO a

491−withTestEnv cb =

492− withConn $ \conn ->

493617 cb TestEnv

494618 { conn = conn

495619 , withConn = withConn

496620 }

497621 where

498− withConn = bracket testConnect close

622+ withConn = bracket (connectPostgreSQL connstr) close

499623

500624main :: IO ()

501−main = withTestEnv $ defaultMain . tests

625+main = withConnstring $ \connstring -> do

626+ withTestEnv connstring (defaultMain . tests)

627+

628+withConnstring :: (BS8.ByteString -> IO ()) -> IO ()

629+withConnstring kont = do

630+ env <- getEnvironment

631+ case lookup "DATABASE_CONNSTRING" env of

632+ Just s -> kont (BS8.pack (special s))

633+ Nothing -> case lookup "GITHUB_ACTIONS" env of

634+ Just "true" -> kont (BS8.pack gha)

635+ _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"

636+ where

637+ -- https://www.appveyor.com/docs/services-databases/

638+ special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"

639+ special "travis" = ""

640+ special s = s

641+

642+ gha = unwords

643+ [ "dbname='postgres'"

644+ , "user='postgres'"

645+ , "password='postgres'"

646+ , "host='postgres'"

647+ , "port=5432"

648+ ]

test/Time.hs+1−1

@@ -36,7 +36,7 @@ module Time (testTime) where

3636

3737import Common

3838import Control.Monad(forM_, replicateM_)

39−import Data.Time

39+import Data.Time.Compat

4040import Data.ByteString(ByteString)

4141import Database.PostgreSQL.Simple.SqlQQ

4242

test/results/malformed-input.expected+1−1

@@ -1,4 +1,4 @@

11user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2−Connection error: ERROR: invalid input syntax for integer: "z"

2+Connection error: ERROR: invalid input syntax for type integer: "z"

33CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

44)

tools/GenTypeInfo.hs+39−25

@@ -21,6 +21,9 @@

2121-- know about. It then constructs a TypeInfo record and stores it in

2222-- a per-connection cache for later use.

2323--

24+-- @

25+-- runghc -itools tools/GenTypeInfo.hs

26+-- @

2427------------------------------------------------------------------------------

2528

2629{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

@@ -38,12 +41,10 @@ import Database.PostgreSQL.Simple.FromRow

3841import Database.PostgreSQL.Simple.Ok

3942import Database.PostgreSQL.Simple.Types(Oid(..))

4043import Database.PostgreSQL.Simple.SqlQQ

41−import qualified Data.ByteString.Char8 as B

44+import qualified Data.ByteString.Char8 as B8

4245import Data.ByteString(ByteString)

4346import qualified Data.ByteString.Lazy as L

44−import qualified Blaze.ByteString.Builder as Blaze

45−import qualified Blaze.ByteString.Builder.ByteString as Blaze

46−import qualified Blaze.ByteString.Builder.Char8 as Blaze

47+import qualified Data.ByteString.Builder as Blaze

4748import Data.String

4849import Data.List ( sort, intersperse )

4950import qualified Data.Map as Map

@@ -69,11 +70,11 @@ data TypeInfo = TypeInfo

6970instance FromRow TypeInfo where

7071 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

7172

72−type NameMap = Map.Map B.ByteString TypeInfo

73+type NameMap = Map.Map B8.ByteString TypeInfo

7374

7475type OidMap = Map.Map Oid TypeInfo

7576

76−type TypeName = (B.ByteString, B.ByteString)

77+type TypeName = (B8.ByteString, B8.ByteString)

7778

7879type TypeNames = [TypeName]

7980

@@ -197,9 +198,6 @@ int8range

197198_int8range

198199|]

199200

200−instance IsString Blaze.Builder where

201− fromString = Blaze.fromByteString . fromString

202−

203201connectionString = "dbname=postgres"

204202

205203withPostgreSQL = bracket (connectPostgreSQL connectionString) close

@@ -237,7 +235,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do

237235

238236main = do

239237 (oidmap, namemap) <- getTypeInfos typeNames

240− L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

238+ L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

241239 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

242240

243241

@@ -246,7 +244,7 @@ showOid (Oid n) = show n

246244renderOid :: NameMap -> TypeName -> Blaze.Builder

247245renderOid byName name

248246 = case Map.lookup (pg name) byName of

249− Nothing -> error (B.unpack (pg name))

247+ Nothing -> error (B8.unpack (pg name))

250248 Just (showOid . typoid -> n) -> fromString n

251249 ++ fromString (replicate (4 - length n) ' ')

252250

@@ -264,20 +262,25 @@ renderTypeInfo byOid info name

264262 typelem_hs_name =

265263 case lookup (typname typelem_info) typeNames of

266264 Nothing -> error ( "type not found: "

267− ++ B.unpack( typname typelem_info)

268− ++ " (typelem of " ++ B.unpack (typname info)

265+ ++ B8.unpack( typname typelem_info)

266+ ++ " (typelem of " ++ B8.unpack (typname info)

269267 ++ ")")

270268 Just x -> x

271269 in concat

272270 [ "\n"

273271 , bs (hs name), " :: TypeInfo\n"

274272 , bs (hs name), " = Array {\n"

275− , " typoid = ", fromString (show (typoid info)), ",\n"

276− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

277− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

273+ , " typoid = ", bs (hs name), "Oid,\n"

274+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

275+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

278276 , " typname = \"", bs (typname info), "\",\n"

279277 , " typelem = ", bs typelem_hs_name, "\n"

280278 , " }\n"

279+ , "\n"

280+ , bs (hs name), "Oid :: Oid\n"

281+ , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"

282+ , "{-# INLINE ", bs (hs name), "Oid #-}"

283+ , "\n"

281284 ]

282285 | typcategory info == 'R' =

283286 let (Just rngsubtype_oid) = rngsubtype info

@@ -285,31 +288,41 @@ renderTypeInfo byOid info name

285288 rngsubtype_hs_name =

286289 case lookup (typname rngsubtype_info) typeNames of

287290 Nothing -> error ( "type not found: "

288− ++ B.unpack (typname rngsubtype_info)

291+ ++ B8.unpack (typname rngsubtype_info)

289292 ++ " (rngsubtype of "

290− ++ B.unpack (typname info) ++ ")")

293+ ++ B8.unpack (typname info) ++ ")")

291294 Just x -> x

292295 in concat

293296 [ "\n"

294297 , bs (hs name), " :: TypeInfo\n"

295298 , bs (hs name), " = Range {\n"

296− , " typoid = ", fromString (show (typoid info)), ",\n"

297− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

298− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

299+ , " typoid = ", bs (hs name), "Oid,\n"

300+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

301+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

299302 , " typname = \"", bs (typname info), "\",\n"

300303 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

301304 , " }\n"

305+ , "\n"

306+ , bs (hs name), "Oid :: Oid\n"

307+ , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"

308+ , "{-# INLINE ", bs (hs name), "Oid #-}"

309+ , "\n"

302310 ]

303311 | otherwise =

304312 concat

305313 [ "\n"

306314 , bs (hs name), " :: TypeInfo\n"

307315 , bs (hs name), " = Basic {\n"

308− , " typoid = ", fromString (show (typoid info)), ",\n"

309− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

310− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

316+ , " typoid = ", bs (hs name), "Oid,\n"

317+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

318+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

311319 , " typname = \"", bs (typname info), "\"\n"

312320 , " }\n"

321+ , "\n"

322+ , bs (hs name), "Oid :: Oid\n"

323+ , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"

324+ , "{-# INLINE ", bs (hs name), "Oid #-}"

325+ , "\n"

313326 ]

314327

315328-- FIXME: add in any names that we need that we didn't specify, (i.e.

@@ -318,7 +331,7 @@ renderTypeInfo byOid info name

318331getNames :: NameMap -> TypeNames -> TypeNames

319332getNames _ x = x

320333

321−bs = Blaze.fromByteString

334+bs = Blaze.byteString

322335

323336pg = fst

324337

@@ -347,6 +360,7 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

347360 ( TypeInfo(..)

348361 , staticTypeInfo

349362|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

363+ ++ " , " ++ bs (hs name) ++ "Oid\n"

350364 | name <- names ] ++ [longstring|

351365 ) where

352366