master..404ab1a · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

46 files changed+718−2250

unifiedsplit

.ghcinew file+16

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

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

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

4+:set -XDoAndIfThenElse

5+:set -XOverloadedStrings

6+:set -XBangPatterns

7+:set -XViewPatterns

8+:set -XTypeOperators

10+-- for tests

11+:set -XNamedFieldPuns

12+:set -XRank2Types

13+:set -XRecordWildCards

14+:set -XPatternGuards

15+:set -XScopedTypeVariables

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

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

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

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

2−#

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

4−#

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

6−#

7−# haskell-ci regenerate

8−#

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

10−#

11−# version: 0.17.20231110

12−#

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

14−#

15−name: Haskell-CI

16−on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

23−jobs:

24− linux:

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

26− runs-on: ubuntu-20.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:bionic

31− services:

32− postgres:

33− image: postgres:14

34− env:

35− POSTGRES_PASSWORD: postgres

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

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

38− strategy:

39− matrix:

40− include:

41− - compiler: ghc-9.8.1

42− compilerKind: ghc

43− compilerVersion: 9.8.1

44− setup-method: ghcup

45− allow-failure: false

46− - compiler: ghc-9.6.3

47− compilerKind: ghc

48− compilerVersion: 9.6.3

49− setup-method: ghcup

50− allow-failure: false

51− - compiler: ghc-9.4.8

52− compilerKind: ghc

53− compilerVersion: 9.4.8

54− setup-method: ghcup

55− allow-failure: false

56− - compiler: ghc-9.2.8

57− compilerKind: ghc

58− compilerVersion: 9.2.8

59− setup-method: ghcup

60− allow-failure: false

61− - compiler: ghc-9.0.2

62− compilerKind: ghc

63− compilerVersion: 9.0.2

64− setup-method: ghcup

65− allow-failure: false

66− - compiler: ghc-8.10.7

67− compilerKind: ghc

68− compilerVersion: 8.10.7

69− setup-method: ghcup

70− allow-failure: false

71− - compiler: ghc-8.8.4

72− compilerKind: ghc

73− compilerVersion: 8.8.4

74− setup-method: hvr-ppa

75− allow-failure: false

76− - compiler: ghc-8.6.5

77− compilerKind: ghc

78− compilerVersion: 8.6.5

79− setup-method: hvr-ppa

80− allow-failure: false

81− fail-fast: false

82− steps:

83− - name: apt

84− run: |

85− apt-get update

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

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

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

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

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

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

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

93− else

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

95− apt-get update

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

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

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

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

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

101− fi

102− env:

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

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

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

106− - name: Set PATH and environment variables

107− run: |

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

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

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

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

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

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

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

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

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

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

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

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

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

121− else

122− HC=$HCDIR/bin/$HCKIND

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

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

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

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

127− fi

128−

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

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

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

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

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

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

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

136− env:

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

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

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

140− - name: env

141− run: |

142− env

143− - name: write cabal config

144− run: |

145− mkdir -p $CABAL_DIR

146− cat >> $CABAL_CONFIG <<EOF

147− remote-build-reporting: anonymous

148− write-ghc-environment-files: never

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

150− logs-dir: $CABAL_DIR/logs

151− world-file: $CABAL_DIR/world

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

153− symlink-bindir: $CABAL_DIR/bin

154− installdir: $CABAL_DIR/bin

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

156− store-dir: $CABAL_DIR/store

157− install-dirs user

158− prefix: $CABAL_DIR

159− repository hackage.haskell.org

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

161− EOF

162− cat >> $CABAL_CONFIG <<EOF

163− program-default-options

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

165− EOF

166− cat $CABAL_CONFIG

167− - name: versions

168− run: |

169− $HC --version || true

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

171− $CABAL --version || true

172− - name: update cabal index

173− run: |

174− $CABAL v2-update -v

175− - name: install cabal-plan

176− run: |

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

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

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

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

181− rm -f cabal-plan.xz

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

183− cabal-plan --version

184− - name: checkout

185− uses: actions/checkout@v3

186− with:

187− path: source

188− - name: initial cabal.project for sdist

189− run: |

190− touch cabal.project

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

192− cat cabal.project

193− - name: sdist

194− run: |

195− mkdir -p sdist

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

197− - name: unpack

198− run: |

199− mkdir -p unpacked

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

201− - name: generate cabal.project

202− run: |

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

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

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

206− touch cabal.project

207− touch cabal.project.local

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

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

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

211− cat >> cabal.project <<EOF

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

213− EOF

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

215− cat cabal.project

216− cat cabal.project.local

217− - name: dump install plan

218− run: |

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

220− cabal-plan

221− - name: restore cache

222− uses: actions/cache/restore@v3

223− with:

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

225− path: ~/.cabal/store

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

227− - name: install dependencies

228− run: |

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

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

231− - name: build w/o tests

232− run: |

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

234− - name: build

235− run: |

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

237− - name: tests

238− run: |

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

240− - name: cabal check

241− run: |

242− cd ${PKGDIR_postgresql_simple} || false

243− ${CABAL} -vnormal check

244− - name: haddock

245− run: |

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

247− - name: unconstrained build

248− run: |

249− rm -f cabal.project.local

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

251− - name: save cache

252− uses: actions/cache/save@v3

253− if: always()

254− with:

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

256− path: ~/.cabal/store

.github/workflows/simple.ymldeleted−58

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

1−name: Simple

2−on:

3− push:

4− branches:

5− - master

6− pull_request:

7− branches:

8− - master

9−

10−jobs:

11− native:

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

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

14− strategy:

15− matrix:

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

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

18− fail-fast: false

19− timeout-minutes:

20− 60

21− steps:

22− - name: Set git to use LF

23− run: |

24− git config --global core.autocrlf false

25− git config --global core.eol lf

26−

27− - name: Set up Haskell

28− id: setup-haskell

29− uses: haskell/actions/setup@v2

30− with:

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

32− cabal-version: '3.10.2.0'

33−

34− - name: Set up PostgreSQL

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

36− id: postgres

37− with:

38− username: ci

39− password: sw0rdfish

40− database: test

41−

42− - name: Checkout

43− uses: actions/checkout@v3.0.2

44−

45− - name: Cache

46− uses: actions/cache@v2.1.3

47− with:

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

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

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

51−

52− - name: Build

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

54−

55− - name: Test

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

57− env:

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

.gitignore−2

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

1313cabal.sandbox.config

1414/dist-newstyle

1515.ghc.environment.*

16−cabal.project.local

17−dump-core

.travis.ymlnew file+123

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

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

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+7−101

@@ -1,100 +1,6 @@

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

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

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

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

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

6− * Drop support for GHC prior 8.6

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

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

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

10−

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

12−

13− * Support `aeson-2.2.0.0`

14−

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

16−

17− * Add `withConnect`

18−

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

20−

21− * Add foldCopyData helper function

22− Thanks to Sebastián Estrella for the implementation

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

24− * Implement support for postgresql 'interval' type

25− Thanks to Andre Marques Lee for the implementation

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

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

28−

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

30−

31− * Add `fromFieldJSONByteString`

32− Thanks to tomjaguarpaw for the implementation

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

34− * Add `attoFieldParser`

35− Thanks to Victor Nawothnig for the implementation

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

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

38− Thanks to Cary Robbins for the implementation

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

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

41− for all exception types.

42− Thanks to Elliot Cameron for the implementation

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

44− * Fix spurious aborts when retrying transactions

45− Thanks to Elliot Cameron for the implementation

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

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

48− with `Aeson` newtype.

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

50−

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

52−

53− * Define `MonadFail Ok`.

54−

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

56−

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

58− Thanks to Felix Paulusma for the implementation.

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

60−

61− * Mention GHC Generics support in the documentation.

62− Thanks to Gabriel Gonzalez for the implementation.

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

64−

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

66− Thanks to Max Amanshauser for the implementation.

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

68−

69− * fromJSONField: Include JSONPath on JSON parse errors

70− Thanks to Simon Hengel for the implementation.

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

72−

73− * No TH in implementation

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

75−

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

77−

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

79−

80− Consider a downstream library depending already both on

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

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

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

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

85−

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

87−

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

89−

90− ```haskell

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

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

93− #endif

94− ```

95−

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

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

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

984

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

1006 Thanks to Max Tagher for the implementation.

@@ -271,7 +177,7 @@

271177 support UTF8 except for Mule Internal Code, the Multilingual

272178 Extensions for Emacs. An exception should be raised upon

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

274− accommodate this requirement.

180+ accomodate this requirement.

275181

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

277183

@@ -391,7 +297,7 @@

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

392298

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

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

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

395301

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

397303 foldWithOptions, executeMany, and returning operators.

@@ -409,7 +315,7 @@

409315

410316 * Changed the Identifier and QualifiedIdentifier to use Text in

411317 order to avoid encoding errors. Technically this requires a

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

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

413319

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

415321 and tweaked error messages.

@@ -569,7 +475,7 @@

569475

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

571477 convenient and efficient access to the pg_type metatable. This

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

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

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

574480 work on this feature.

575481

@@ -661,7 +567,7 @@

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

662568

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

664− that accommodate PostgreSQL's infinities.

570+ that accomodate PostgreSQL's infinities.

665571

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

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

CONTRIBUTING.mddeleted−13

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

1−Patches welcome!

2−

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

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

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

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

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

8−

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

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

11−

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

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

README.md+3

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

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

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

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

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

cabal.haskell-cideleted−5

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

1−branches: master

2−postgresql: True

3−

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

5−-- osx: 8.4.4

cabal.project−3

@@ -1,4 +1 @@

11packages: .

2−tests: true

3−

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

cabal.project.local.windeleted−4

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

1−constraints: these -assoc

2−

3−package postgresql-libpq

4− flags: -use-pkg-config

postgresql-simple.cabal+136−136

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

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.

8−

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

1+Cabal-version: 1.12

2+Name: postgresql-simple

3+Version: 0.6

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: Leon P Smith <leon@melding-monads.com>

14+Category: Database

15+Build-type: Simple

16+

2017extra-source-files:

21− CHANGES.md

2218 CONTRIBUTORS

19+ CHANGES.md

2320 test/results/malformed-input.expected

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

2522

2623tested-with:

27− GHC ==8.6.5

28− || ==8.8.4

29− || ==8.10.7

30− || ==9.0.2

31− || ==9.2.8

32− || ==9.4.8

33− || ==9.6.3

34− || ==9.8.1

35−

36−library

37− default-language: Haskell2010

38− hs-source-dirs: src

39− exposed-modules:

40− Database.PostgreSQL.Simple

41− Database.PostgreSQL.Simple.Arrays

42− Database.PostgreSQL.Simple.Copy

43− Database.PostgreSQL.Simple.Cursor

44− Database.PostgreSQL.Simple.Errors

45− Database.PostgreSQL.Simple.FromField

46− Database.PostgreSQL.Simple.FromRow

47− Database.PostgreSQL.Simple.HStore

48− Database.PostgreSQL.Simple.HStore.Internal

49− Database.PostgreSQL.Simple.Internal

50− Database.PostgreSQL.Simple.LargeObjects

51− Database.PostgreSQL.Simple.Newtypes

52− Database.PostgreSQL.Simple.Notification

53− Database.PostgreSQL.Simple.Ok

54− Database.PostgreSQL.Simple.Range

55− Database.PostgreSQL.Simple.SqlQQ

56− Database.PostgreSQL.Simple.Time

57− Database.PostgreSQL.Simple.Time.Internal

58− Database.PostgreSQL.Simple.ToField

59− Database.PostgreSQL.Simple.ToRow

60− Database.PostgreSQL.Simple.Transaction

61− Database.PostgreSQL.Simple.TypeInfo

62− Database.PostgreSQL.Simple.TypeInfo.Macro

63− Database.PostgreSQL.Simple.TypeInfo.Static

64− Database.PostgreSQL.Simple.Types

65− Database.PostgreSQL.Simple.Vector

66− Database.PostgreSQL.Simple.Vector.Unboxed

67−

68− -- Other-modules:

69− other-modules:

70− Database.PostgreSQL.Simple.Compat

71− Database.PostgreSQL.Simple.HStore.Implementation

72− Database.PostgreSQL.Simple.Internal.PQResultUtils

73− Database.PostgreSQL.Simple.Time.Implementation

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

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

76− Database.PostgreSQL.Simple.TypeInfo.Types

24+ GHC == 7.6.3

25+ || == 7.8.4

26+ || == 7.10.3

27+ || == 8.0.2

28+ || == 8.2.2

29+ || == 8.4.4

30+ || == 8.6.1

31+

32+Library

33+ default-language: Haskell2010

34+ hs-source-dirs: src

35+ Exposed-modules:

36+ Database.PostgreSQL.Simple

37+ Database.PostgreSQL.Simple.Arrays

38+ Database.PostgreSQL.Simple.Copy

39+ Database.PostgreSQL.Simple.Cursor

40+ Database.PostgreSQL.Simple.FromField

41+ Database.PostgreSQL.Simple.FromRow

42+ Database.PostgreSQL.Simple.LargeObjects

43+ Database.PostgreSQL.Simple.HStore

44+ Database.PostgreSQL.Simple.HStore.Internal

45+ Database.PostgreSQL.Simple.Notification

46+ Database.PostgreSQL.Simple.Ok

47+ Database.PostgreSQL.Simple.Range

48+ Database.PostgreSQL.Simple.SqlQQ

49+ Database.PostgreSQL.Simple.Time

50+ Database.PostgreSQL.Simple.Time.Internal

51+ Database.PostgreSQL.Simple.ToField

52+ Database.PostgreSQL.Simple.ToRow

53+ Database.PostgreSQL.Simple.Transaction

54+ Database.PostgreSQL.Simple.TypeInfo

55+ Database.PostgreSQL.Simple.TypeInfo.Macro

56+ Database.PostgreSQL.Simple.TypeInfo.Static

57+ Database.PostgreSQL.Simple.Types

58+ Database.PostgreSQL.Simple.Errors

59+ Database.PostgreSQL.Simple.Vector

60+ Database.PostgreSQL.Simple.Vector.Unboxed

61+

62+-- Other-modules:

63+ Database.PostgreSQL.Simple.Internal

64+

65+ Other-modules:

66+ Database.PostgreSQL.Simple.Compat

67+ Database.PostgreSQL.Simple.HStore.Implementation

68+ Database.PostgreSQL.Simple.Internal.PQResultUtils

69+ Database.PostgreSQL.Simple.Time.Implementation

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

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

72+ Database.PostgreSQL.Simple.TypeInfo.Types

7773

7874 -- GHC bundled libs

79− build-depends:

80− base >=4.12.0.0 && <4.20

81− , bytestring >=0.10.8.2 && <0.13

82− , containers >=0.6.0.1 && <0.7

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

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

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

86− , transformers >=0.5.6.2 && <0.7

75+ Build-depends:

76+ base >=4.6.0.0 && <4.13

77+ , bytestring >=0.10.0.0 && <0.11

78+ , containers >=0.5.0.0 && <0.7

79+ , time >=1.4.0.1 && <1.9

80+ , transformers >=0.3.0.0 && <0.6

81+ , template-haskell >=2.8.0.0 && <2.15

82+ , text >=1.2.3.0 && <1.3

8783

8884 -- Other dependencies

89− build-depends:

90− aeson >=2.1.2.1 && <2.3

91− , attoparsec >=0.14.4 && <0.15

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

93− , hashable >=1.4.3.0 && <1.5

94− , Only >=0.1 && <0.1.1

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

96− , scientific >=0.3.7.0 && <0.4

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

98− , vector >=0.13.0.0 && <0.14

85+ Build-depends:

86+ aeson >=1.4.1.0 && <1.5

87+ , attoparsec >=0.13.2.2 && <0.14

88+ , bytestring-builder >=0.10.8.1.0 && <0.11

89+ , case-insensitive >=1.2.0.11 && <1.3

90+ , hashable >=1.2.7.0 && <1.3

91+ , Only >=0.1 && <0.1.1

92+ , postgresql-libpq >=0.9.4.2 && < 0.10

93+ , uuid-types >=1.0.3 && <1.1

94+ , scientific >=0.3.6.2 && <0.4

95+ , vector >=0.12.0.1 && <0.13

96+

97+ if !impl(ghc >= 8.0)

98+ Build-depends:

99+ semigroups >=0.18.5 && <0.19

100+

101+ if !impl(ghc >= 7.6)

102+ Build-depends:

103+ ghc-prim

99104

100105 default-extensions:

101− BangPatterns

102106 DoAndIfThenElse

103107 OverloadedStrings

104− TypeOperators

108+ BangPatterns

105109 ViewPatterns

110+ TypeOperators

106111

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

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

108113

109114source-repository head

110115 type: git

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

116+ location: http://github.com/phadej/postgresql-simple

112117

113−test-suite inspection

114− default-language: Haskell2010

115− type: exitcode-stdio-1.0

116− hs-source-dirs: test

117− main-is: Inspection.hs

118− build-depends:

119− base

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

121− , postgresql-libpq

122− , postgresql-simple

123− , tasty

124− , tasty-hunit

118+source-repository this

119+ type: git

120+ location: http://github.com/phadej/postgresql-simple

121+ tag: v0.6

125122

126123test-suite test

127− default-language: Haskell2010

128− type: exitcode-stdio-1.0

129− hs-source-dirs: test

130− main-is: Main.hs

124+ default-language: Haskell2010

125+ type: exitcode-stdio-1.0

126+

127+ hs-source-dirs: test

128+ main-is: Main.hs

131129 other-modules:

132130 Common

133− Exception

134− Interval

135131 Notify

136132 Serializable

137133 Time

138134

139− ghc-options: -threaded

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

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

136+

141137 default-extensions:

142138 NamedFieldPuns

143139 OverloadedStrings

144− PatternGuards

145140 Rank2Types

146141 RecordWildCards

142+ PatternGuards

147143 ScopedTypeVariables

148144

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

145+ build-depends: base

146+ , aeson

147+ , base16-bytestring

148+ , bytestring

149+ , containers

150+ , cryptohash

151+ , filepath

152+ , tasty

153+ , tasty-hunit

154+ , tasty-golden

155+ , HUnit

156+ , postgresql-simple

157+ , text

158+ , time

159+ , vector

160+ , case-insensitive

161+

162+ if !impl(ghc >= 7.6)

163+ build-depends:

164+ ghc-prim

166165

167166benchmark select

168167 default-language: Haskell2010

169168 type: exitcode-stdio-1.0

170− hs-source-dirs: bench

171− main-is: Select.hs

172− build-depends:

173− base

174− , postgresql-simple

175− , vector

169+

170+ hs-source-dirs: bench

171+ main-is: Select.hs

172+

173+ build-depends: base

174+ , postgresql-simple

175+ , vector

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

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

6464 , Only(..)

6565 , (:.)(..)

6666 -- ** Exceptions

67− , SomePostgreSqlException(..)

6867 , SqlError(..)

6968 , PQ.ExecStatus(..)

7069 , FormatError(..)

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

7473 , Base.connectPostgreSQL

7574 , Base.close

7675 , Base.connect

77− , Base.withConnect

7876 , Base.ConnectInfo(..)

7977 , Base.defaultConnectInfo

8078 , Base.postgreSQLConnectionString

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

278276 skipSpace = B.dropWhile isSpace_ascii

279277

280278

279+

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

282281buildQuery conn q template xs =

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

284283 where split 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

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

288285 in byteString h

289286 : if B.null t

290287 then []

291288 else split (B.tail t)

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

293290 zipParams [t] [] = t

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

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

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

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

296293 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

306294

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

308296-- expected to return results.

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

340328-- @

341329-- executeMany c [sql|

342330-- UPDATE sometable

343−-- SET y = upd.y

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

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

345333-- WHERE sometable.x = upd.x

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

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

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

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

535523 -> IO a

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

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

537525

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

539527foldWithOptionsAndParser_ :: FoldOptions

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

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

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

545533 -> IO a

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

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

547535

548536doFold :: FoldOptions

549537 -> RowParser row

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

579567 go = bracket declare closeCursor $ \cursor ->

580568 let loop a = fetch cursor a >>=

581569 \r -> case r of

582− Left x -> return x

583− Right x -> loop x

570+ Left a -> return a

571+ Right a -> loop a

584572 in loop a0

585573

586574-- FIXME: choose the Automatic chunkSize more intelligently

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

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

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

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

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

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

906894--

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

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

1212 ) where

1313

1414import qualified Control.Exception as E

15+import Data.Monoid

1516import Data.ByteString (ByteString)

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

1618import Data.ByteString.Lazy (toStrict)

19+#else

20+import qualified Data.ByteString as B

21+import Data.ByteString.Lazy (toChunks)

22+#endif

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

24+

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

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

27+#else

28+import Data.Scientific (scientificBuilder)

29+#endif

30+

31+#if __GLASGOW_HASKELL__ >= 702

1932import System.IO.Unsafe (unsafeDupablePerformIO)

33+#elif __GLASGOW_HASKELL__ >= 611

34+import GHC.IO (unsafeDupablePerformIO)

35+#else

36+import GHC.IOBase (unsafeDupablePerformIO)

37+#endif

38+

2039import Data.Fixed (Pico)

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

2141import Data.Fixed (Fixed(MkFixed))

42+#else

43+import Unsafe.Coerce (unsafeCoerce)

44+#endif

2245

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

2447--

@@ -28,14 +51,44 @@ import Data.Fixed (Fixed(MkFixed))

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

2952-- don't need that polymorphism.

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

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

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

3261{-# INLINE mask #-}

3362

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+

3471toByteString :: Builder -> ByteString

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

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

3679

3780toPico :: Integer -> Pico

3881toPico = MkFixed

3982

4083fromPico :: Pico -> Integer

4184fromPico (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+6−27

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

3232 ( copy

3333 , copy_

3434 , CopyOutResult(..)

35− , foldCopyData

3635 , getCopyData

3736 , putCopyData

3837 , putCopyEnd

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

4948import qualified Database.PostgreSQL.LibPQ as PQ

5049import Database.PostgreSQL.Simple

5150import Database.PostgreSQL.Simple.Types

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

51+import Database.PostgreSQL.Simple.Internal

5352

5453

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

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

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

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

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

5958

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

6160copy conn template qs = do

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

8685 PQ.TuplesOk -> err

8786 PQ.CopyOut -> return ()

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

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

93+#endif

9194 PQ.BadResponse -> throwResultError funcName result status

9295 PQ.NonfatalError -> throwResultError funcName result status

9396 PQ.FatalError -> throwResultError funcName result status

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

101104 deriving (Eq, Typeable, Show)

102105

103106

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−

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

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

130109-- 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 hiding (result, row)

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

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 x !n

94− | n > hi = return x

93+ loop a !n

94+ | n > hi = return a

9595 | otherwise = do

96− x' <- f x n

97− loop x' (n+1)

96+ a' <- f a n

97+ loop a' (n+1)

9898{-# INLINE foldM' #-}

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

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

2525 )

2626 where

2727

28+import Control.Applicative

2829import Control.Exception as E

2930

3031import Data.Attoparsec.ByteString.Char8

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

5960 deriving (Show, Eq, Ord, Typeable)

6061

6162-- Default instance should be enough

62−instance Exception ConstraintViolation where

63− toException = postgresqlExceptionToException

64− fromException = postgresqlExceptionFromException

63+instance Exception ConstraintViolation

6564

6665

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

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

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

6968--

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

7170-- > where

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

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

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

4−{-# LANGUAGE RecordWildCards #-}

5−{-# LANGUAGE PolyKinds #-}

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

76{- |

87Module: Database.PostgreSQL.Simple.FromField

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

107106 , PQ.Oid(..)

108107 , PQ.Format(..)

109108 , pgArrayFieldParser

110− , attoFieldParser

111109

112110 , optionalField

113111 , fromJSONField

114− , fromFieldJSONByteString

115112 ) where

116113

117114#include "MachDeps.h"

118115

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

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

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

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

118+import Control.Exception (Exception)

122119import qualified Data.Aeson as JSON

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

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

124122import Data.ByteString (ByteString)

125123import qualified Data.ByteString.Char8 as B

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

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

128125import Data.IORef (IORef, newIORef)

129126import Data.Ratio (Ratio)

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

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

131128import Data.Typeable (Typeable, typeOf)

132129import Data.Vector (Vector)

133130import Data.Vector.Mutable (IOVector)

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

138135import Database.PostgreSQL.Simple.Types

139136import Database.PostgreSQL.Simple.TypeInfo as TI

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

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

141139import Database.PostgreSQL.Simple.Time

142140import Database.PostgreSQL.Simple.Arrays as Arrays

143141import qualified Database.PostgreSQL.LibPQ as PQ

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

154152import Data.Scientific (Scientific)

155153import GHC.Real (infinity, notANumber)

156154

157−import qualified Data.Aeson.Types as JSON

158−

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

160156-- value fails.

161157data ResultError = Incompatible { errSQLType :: String

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

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

183179 deriving (Eq, Show, Typeable)

184180

185−instance Exception ResultError where

186− toException = postgresqlExceptionToException

187− fromException = postgresqlExceptionFromException

181+instance Exception ResultError

188182

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

190184left = conversionError

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

250244 then Nothing

251245 else Just x

252246

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

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

258250

259251tableColumn :: Field -> Int

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

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

270262-- | void

271263instance FromField () where

272264 fromField f _bs

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

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

274266 | otherwise = pure ()

275267

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−

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

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

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

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

306292-- | bool

307293instance FromField Bool where

308294 fromField f bs

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

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

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

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

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

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

314300

315301-- | \"char\", bpchar

316302instance FromField Char where

317− fromField f bs0 =

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

319− then case bs0 of

303+ fromField f bs =

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

305+ then case bs of

320306 Nothing -> returnError UnexpectedNull f ""

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

322308 then returnError ConversionFailed f "length not 1"

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

325311

326312-- | int2

327313instance FromField Int16 where

328− fromField = attoFieldParser ok16 $ signed decimal

314+ fromField = atto ok16 $ signed decimal

329315

330316-- | int2, int4

331317instance FromField Int32 where

332− fromField = attoFieldParser ok32 $ signed decimal

318+ fromField = atto ok32 $ signed decimal

333319

334320#if WORD_SIZE_IN_BITS < 64

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

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

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

340326#endif

341327instance FromField Int where

342− fromField = attoFieldParser okInt $ signed decimal

328+ fromField = atto okInt $ signed decimal

343329

344330-- | int2, int4, int8

345331instance FromField Int64 where

346− fromField = attoFieldParser ok64 $ signed decimal

332+ fromField = atto ok64 $ signed decimal

347333

348334-- | int2, int4, int8

349335instance FromField Integer where

350− fromField = attoFieldParser ok64 $ signed decimal

336+ fromField = atto ok64 $ signed decimal

351337

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

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

354340instance FromField Float where

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

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

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

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

357343

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

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

360346instance FromField Double where

361− fromField = attoFieldParser ok pg_double

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

347+ fromField = atto ok pg_double

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

363349

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

365351instance FromField (Ratio Integer) where

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

352+ fromField = atto ok pg_rational

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

368354

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

370356instance FromField Scientific where

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

357+ fromField = atto ok rational

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

373359

374360unBinary :: Binary t -> t

375361unBinary (Binary x) = x

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

390376

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

392378instance FromField SB.ByteString where

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

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

394380 then unBinary <$> fromField f dat

395381 else doFromField f okText' pure dat

396382

397383-- | oid

398384instance FromField PQ.Oid where

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

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

400386

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

402388instance FromField LB.ByteString where

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

404390

405391unescapeBytea :: Field -> SB.ByteString

406392 -> Conversion (Binary SB.ByteString)

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

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

408394 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

409395 Just str -> pure (Binary str)

410396

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

455441

456442-- | timestamptz

457443instance FromField UTCTime where

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

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

459445

460446-- | timestamptz

461447instance FromField ZonedTime where

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

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

463449

464450-- | timestamp

465451instance FromField LocalTime where

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

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

467453

468454-- | date

469455instance FromField Day where

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

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

471457

472458-- | time

473459instance FromField TimeOfDay where

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

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

475461

476462-- | timestamptz

477463instance FromField UTCTimestamp where

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

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

479465

480466-- | timestamptz

481467instance FromField ZonedTimestamp where

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

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

483469

484470-- | timestamp

485471instance FromField LocalTimestamp where

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

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

487473

488474-- | date

489475instance FromField Date where

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

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

500477

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

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

503−ff compatOid hsType parseBS f mstr =

480+ff compatOid hsType parse f mstr =

504481 if typeOid f /= compatOid

505482 then err Incompatible ""

506483 else case mstr of

507484 Nothing -> err UnexpectedNull ""

508− Just str -> case parseBS str of

485+ Just str -> case parse str of

509486 Left msg -> err ConversionFailed msg

510487 Right val -> return val

511488 where

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

543520 _ -> returnError Incompatible f ""

544521

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

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

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

547524 where

548− delim = typdelim (typelem typInfo)

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

525+ delim = typdelim (typelem typeInfo)

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

550527

551528 parseIt item =

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

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

564541-- | uuid

565542instance FromField UUID where

566543 fromField f mbs =

567− if typeOid f /= TI.uuidOid

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

568545 then returnError Incompatible f ""

569546 else case mbs of

570547 Nothing -> returnError UnexpectedNull f ""

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

575552

576553-- | json, jsonb

577554instance FromField JSON.Value where

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

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

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

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

580557 Left err -> returnError ConversionFailed f err

581558 Right val -> pure val

582559

583560-- | Return the JSON ByteString directly

584−--

585−-- @since 0.6.3

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

587562fromFieldJSONByteString f mbs =

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

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

589564 then returnError Incompatible f ""

590565 else case mbs of

591566 Nothing -> returnError UnexpectedNull f ""

592567 Just bs -> pure bs

593568

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

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

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

596571--

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

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

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

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

614589fromJSONField f mbBs = do

615590 value <- fromField f mbBs

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

591+ case JSON.fromJSON value of

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

593+ "JSON decoding error: " ++ err

594+ JSON.Success x -> pure x

620595

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

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

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

633608type Compat = PQ.Oid -> Bool

634609

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

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

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

644619#if WORD_SIZE_IN_BITS < 64

645620okInt = ok32

646621#else

647622okInt = ok64

648623#endif

649624

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−

663625doFromField :: forall a . (Typeable a)

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

665627 -> Maybe ByteString -> Conversion a

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

684646 (show (typeOf (undefined :: a)))

685647 msg

686648

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

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

703653 where

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

705655 go p s =

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

@@ -67,23 +67,6 @@ 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−--

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

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

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

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

131114 else do

132115 let !result = rowresult

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

134− !field' = Field{..}

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

117+ !field = Field{..}

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

136119

137120field :: FromField a => RowParser a

138121field = fieldWith fromField

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

@@ -22,6 +22,9 @@ 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

2528import Data.Map(Map)

2629import qualified Data.Map as Map

2730import Data.Text(Text)

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

5053toBuilder :: HStoreBuilder -> Builder

5154toBuilder x = case x of

5255 Empty -> mempty

53− Comma c -> c

56+ Comma x -> x

5457

5558toLazyByteString :: HStoreBuilder -> BL.ByteString

5659toLazyByteString x = case x of

5760 Empty -> BL.empty

58− Comma c -> BU.toLazyByteString c

61+ Comma x -> BU.toLazyByteString x

5962

6063instance Semigroup HStoreBuilder where

6164 Empty <> x = x

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

6669

6770instance Monoid HStoreBuilder where

6871 mempty = Empty

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

73+ mappend = (<>)

74+#endif

6975

7076class ToHStoreText a where

7177 toHStoreText :: a -> HStoreText

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

144150

145151instance ToHStore HStoreMap where

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

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

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

148154

149155instance ToField HStoreMap where

150156 toField xs = toField (toHStore xs)

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

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

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

22{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

33{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE ExistentialQuantification #-}

5−{-# LANGUAGE InstanceSigs #-}

75------------------------------------------------------------------------------

86-- |

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

3634import qualified Data.IntMap as IntMap

3735import Data.IORef

3836import Data.Maybe(fromMaybe)

37+import Data.Monoid

3938import Data.String

4039import qualified Data.Text as T

4140import qualified Data.Text.Encoding as TE

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

8382instance Eq Connection where

8483 x == y = connectionHandle x == connectionHandle y

8584

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−

10585data SqlError = SqlError {

10686 sqlState :: ByteString

10787 , sqlExecStatus :: ExecStatus

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

11393fatalError :: ByteString -> SqlError

11494fatalError msg = SqlError "" FatalError msg "" ""

11595

116−instance Exception SqlError where

117− toException = postgresqlExceptionToException

118− fromException = postgresqlExceptionFromException

119−

96+instance Exception SqlError

12097

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

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

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

125102 , qeQuery :: Query

126103 } deriving (Eq, Show, Typeable)

127104

128−instance Exception QueryError where

129− toException = postgresqlExceptionToException

130− fromException = postgresqlExceptionFromException

105+instance Exception QueryError

131106

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

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

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

138113 , fmtParams :: [ByteString]

139114 } deriving (Eq, Show, Typeable)

140115

141−instance Exception FormatError where

142− toException = postgresqlExceptionToException

143− fromException = postgresqlExceptionFromException

116+instance Exception FormatError

144117

145118data ConnectInfo = ConnectInfo {

146119 connectHost :: String

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

182155connect :: ConnectInfo -> IO Connection

183156connect = connectPostgreSQL . postgreSQLConnectionString

184157

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−

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

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

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

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

323290

324291 str name field

325292 | null value = id

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

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

327294 where value = field connectInfo

328295

329296 num name field

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

331298 | otherwise = showString name . shows value . space

332299 where value = field connectInfo

333300

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

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

335302 where

336303 delta c cs = case c of

337304 '\\' -> '\\' : '\\' : cs

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

419386 nstr <- PQ.cmdTuples result

420387 return $ case nstr of

421388 Nothing -> 0 -- is this appropriate?

422− Just str -> mkInteger str

389+ Just str -> toInteger str

423390 PQ.TuplesOk -> do

424391 ncols <- PQ.nfields result

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

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

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

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

434401 where

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

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

436403 where

437404 delta acc c =

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

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

447414 PQ.resultErrorField result PQ.DiagMessageDetail

448415 hint <- fromMaybe "" <$>

449416 PQ.resultErrorField result PQ.DiagMessageHint

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

451− throwIO $ SqlError { sqlState = state'

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

418+ throwIO $ SqlError { sqlState = state

452419 , sqlExecStatus = status

453420 , sqlErrorMsg = errormsg

454421 , sqlErrorDetail = detail

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

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

518485

519486instance Monad Conversion where

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

488+ return = pure

489+#endif

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

521491 oka <- runConversion m conn

522492 case oka of

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

619589

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

621591escapeByteaConn = 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+6−2

@@ -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 hiding (result, row)

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

2929import Database.PostgreSQL.Simple.TypeInfo

3030import qualified Database.PostgreSQL.LibPQ as PQ

3131import qualified Data.ByteString.Char8 as B

@@ -73,11 +73,15 @@ 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 (did you mean to use `execute` or forget a RETURNING?)"

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

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)

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

81+#endif

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

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

84+#endif

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

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

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

src/Database/PostgreSQL/Simple/Newtypes.hsdeleted−49

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

1−{-# LANGUAGE DeriveFunctor #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

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

4−--

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

6−module Database.PostgreSQL.Simple.Newtypes (

7− Aeson (..), getAeson,

8−) where

9−

10−import Data.Typeable (Typeable)

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

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

13−

14−import qualified Data.Aeson as Aeson

15−

16−-------------------------------------------------------------------------------

17−-- aeson

18−-------------------------------------------------------------------------------

19−

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

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

22−--

23−-- Example using @DerivingVia@:

24−--

25−-- @

26−-- data Foo = Foo Int String

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

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

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

30−-- @

31−--

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

33−--

34−-- @

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

36−-- @

37−--

38−-- @since 0.6.3

39−newtype Aeson a = Aeson a

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

41−

42−getAeson :: Aeson a -> a

43−getAeson (Aeson a) = a

44−

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

46− toField = toField . Aeson.encode . getAeson

47−

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

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

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

@@ -47,6 +47,8 @@ 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 )

5052#else

5153import GHC.Conc ( atomically )

5254import Control.Concurrent ( threadWaitReadSTM )

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

9294 -- with async exceptions, whereas threadDelay can.

9395 Just _fd -> do

9496 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

95112#else

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

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

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

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

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

3838import Data.Typeable

3939

40−import qualified Control.Monad.Fail as Fail

41−

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

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

4442

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

7270 mplus = (<|>)

7371

7472instance Monad Ok where

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

74+ return = pure

75+#endif

76+

7577 Errors es >>= _ = Errors es

7678 Ok a >>= f = f a

7779

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

79− fail = Fail.fail

80−#endif

81−

82−instance Fail.MonadFail Ok where

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

8481

8582-- | 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.Compat (Day, LocalTime,

41+import Data.Time (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 y =

113+ checkLB lb x =

114114 case lb of

115115 NegInfinity -> True

116116 PosInfinity -> False

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

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

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

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

119119

120− checkUB ub y =

120+ checkUB ub x =

121121 case ub of

122122 NegInfinity -> False

123123 PosInfinity -> True

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

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

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

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

126126

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

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

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

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

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 800

3−{-# LANGUAGE TemplateHaskellQuotes #-}

4−#else

51{-# LANGUAGE TemplateHaskell #-}

6−#endif

72------------------------------------------------------------------------------

83-- |

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

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

3530-- > (beginTime,endTime,string)

3631--

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

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

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

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

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

4136--

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

5752

5853sql :: QuasiQuoter

5954sql = QuasiQuoter

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"

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"

6259 , quoteExp = sqlExp

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

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

61+ \ quasiquoter used in declaration context"

6462 }

6563

6664sqlExp :: String -> Q Exp

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

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

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

8987 instring (x:xs) = x : instring xs

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

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

89+ \ string literal not terminated"

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

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

227227 , parseUTCTimestamp

228228 , parseZonedTimestamp

229229 , parseLocalTimestamp

230− , parseCalendarDiffTime

231230 , dayToBuilder

232231 , utcTimeToBuilder

233232 , zonedTimeToBuilder

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

240239 , localTimestampToBuilder

241240 , unboundedToBuilder

242241 , nominalDiffTimeToBuilder

243− , calendarDiffTimeToBuilder

244242 ) where

245243

246244import Database.PostgreSQL.Simple.Time.Implementation

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

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

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

1919import Control.Applicative

2020import qualified Data.ByteString as B

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

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

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

2322import Data.Typeable

2423import Data.Maybe (fromMaybe)

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

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

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

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

8079

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

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

83−

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

8581getUnbounded getFinite

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

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

129125getUTCTimestamp :: A.Parser UTCTimestamp

130126getUTCTimestamp = getUnbounded getUTCTime

131127

132−getCalendarDiffTime :: A.Parser CalendarDiffTime

133−getCalendarDiffTime = TP.calendarDiffTime

134−

135128dayToBuilder :: Day -> Builder

136129dayToBuilder = primBounded TPP.day

137130

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

171164

172165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

173166nominalDiffTimeToBuilder = TPP.nominalDiffTime

174−

175−calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

176−calendarDiffTimeToBuilder = TPP.calendarDiffTime

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

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

2121 , localToUTCTimeOfDayHMS

2222 , utcTime

2323 , zonedTime

24− , calendarDiffTime

2524 ) where

2625

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

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

2928import Data.Attoparsec.ByteString.Char8 as A

3029import Data.Bits ((.&.))

31−import Data.ByteString (ByteString)

3230import Data.Char (ord)

3331import Data.Fixed (Pico)

3432import Data.Int (Int64)

3533import Data.Maybe (fromMaybe)

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)

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

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

4036import qualified Data.ByteString.Char8 as B8

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

37+import qualified Data.Time.LocalTime as Local

4238

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

4440day :: Parser Day

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

197193

198194utc :: Local.TimeZone

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

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

1717 , localTime

1818 , zonedTime

1919 , nominalDiffTime

20− , calendarDiffTime

2120 ) where

2221

2322import Control.Arrow ((>>>))

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

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

2524import Data.ByteString.Builder.Prim

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

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

2827import Data.Char ( chr )

2928import Data.Int ( Int32, Int64 )

30−import Data.String (fromString)

31−import Data.Time.Compat

29+import Data.Time

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

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

3432 , TimeZone, timeZoneMinutes )

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

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

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

3834import Unsafe.Coerce (unsafeCoerce)

3935

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

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

126122 where

127123 (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+11−22

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

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3−{-# LANGUAGE PolyKinds #-}

54------------------------------------------------------------------------------

65-- |

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

2322 , inQuotes

2423 ) where

2524

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

2725import qualified Data.Aeson as JSON

2826import Data.ByteString (ByteString)

2927import Data.ByteString.Builder

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

3230 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

3331 , floatDec, doubleDec

3432 )

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

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

3734import Data.List (intersperse)

3835import Data.Monoid (mappend)

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

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

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

4137import Data.Typeable (Typeable)

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

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

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

5955import qualified Database.PostgreSQL.LibPQ as PQ

6056import Database.PostgreSQL.Simple.Time

6157import Data.Scientific (Scientific)

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

6259import 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,14 +100,6 @@ 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−

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

112104 toField Nothing = renderNull

113105 toField (Just a) = toField a

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

290282 toField = Plain . inQuotes . nominalDiffTimeToBuilder

291283 {-# INLINE toField #-}

292284

293−instance ToField CalendarDiffTime where

294− toField = Plain . inQuotes . calendarDiffTimeToBuilder

295− {-# INLINE toField #-}

296−

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

298286 toField pgArray =

299287 case fromPGArray pgArray of

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

314302instance ToField JSON.Value where

315303 toField = toField . JSON.encode

316304

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

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

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

318307--

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

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

321310-- PostgreSQL.

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

323−toJSONField = toField . JSON.encode

312+toJSONField = toField . JSON.toJSON

324313

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

326315--

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

330319 where quote = char8 '\''

331320

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

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

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

334323{-# INLINE interleaveFoldr #-}

335324

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

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

377366

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

379368 typedRows [] _ _ = error funcname

380− typedRows (val:vals) typs rest =

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

369+ typedRows (val:vals) types rest =

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

382371

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

384373 untypedRows [] _ = error funcname

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

@@ -30,22 +30,6 @@ 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.

4933class ToRow a where

5034 toRow :: a -> [Action]

5135 default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

src/Database/PostgreSQL/Simple/Transaction.hs+12−16

@@ -17,7 +17,6 @@ module Database.PostgreSQL.Simple.Transaction

1717 , withTransactionLevel

1818 , withTransactionMode

1919 , withTransactionModeRetry

20− , withTransactionModeRetry'

2120 , withTransactionSerializable

2221 , TransactionMode(..)

2322 , IsolationLevel(..)

@@ -147,34 +146,31 @@ withTransactionMode mode conn act =

147146 commit conn

148147 return r

149148

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

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

152−withTransactionModeRetry = withTransactionModeRetry'

153−

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

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@

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'

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

159154--

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

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

162−withTransactionModeRetry' mode shouldRetry conn act =

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

157+withTransactionModeRetry mode shouldRetry conn act =

163158 mask $ \restore ->

164159 retryLoop $ E.try $ do

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

160+ a <- restore act

166161 commit conn

167162 return a

168163 where

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

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

170165 retryLoop act' = do

171166 beginMode mode conn

172167 r <- act'

173168 case r of

174− Left e ->

175− case shouldRetry e of

176− True -> retryLoop act'

177− False -> E.throwIO e

169+ Left e -> do

170+ rollback_ conn

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

172+ Just True -> retryLoop act'

173+ _ -> E.throwIO e

178174 Right a ->

179175 return a

180176

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+3−9

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

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 800

3−{-# LANGUAGE TemplateHaskellQuotes #-}

4−#else

51{-# LANGUAGE TemplateHaskell #-}

6−#endif

83------------------------------------------------------------------------------

94-- |

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

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

2823import Language.Haskell.TH

2924

25+

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

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

3228mkCompats :: [TypeInfo] -> ExpQ

33−mkCompats tys = do

34− x <- newName "x"

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

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

3630 where

3731 alt :: TypeInfo -> MatchQ

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

@@ -44,7 +38,7 @@ mkCompats tys = do

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

4539-- not to fold constants.

4640inlineTypoid :: TypeInfo -> ExpQ

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

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

4842

4943inlineTypoidP :: TypeInfo -> PatQ

5044inlineTypoidP ty = litP (getTypoid ty)

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

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

1919 ( TypeInfo(..)

2020 , staticTypeInfo

2121 , bool

22− , boolOid

2322 , bytea

24− , byteaOid

2523 , char

26− , charOid

2724 , name

28− , nameOid

2925 , int8

30− , int8Oid

3126 , int2

32− , int2Oid

3327 , int4

34− , int4Oid

3528 , regproc

36− , regprocOid

3729 , text

38− , textOid

3930 , oid

40− , oidOid

4131 , tid

42− , tidOid

4332 , xid

44− , xidOid

4533 , cid

46− , cidOid

4734 , xml

48− , xmlOid

4935 , point

50− , pointOid

5136 , lseg

52− , lsegOid

5337 , path

54− , pathOid

5538 , box

56− , boxOid

5739 , polygon

58− , polygonOid

5940 , line

60− , lineOid

6141 , cidr

62− , cidrOid

6342 , float4

64− , float4Oid

6543 , float8

66− , float8Oid

6744 , unknown

68− , unknownOid

6945 , circle

70− , circleOid

7146 , money

72− , moneyOid

7347 , macaddr

74− , macaddrOid

7548 , inet

76− , inetOid

7749 , bpchar

78− , bpcharOid

7950 , varchar

80− , varcharOid

8151 , date

82− , dateOid

8352 , time

84− , timeOid

8553 , timestamp

86− , timestampOid

8754 , timestamptz

88− , timestamptzOid

8955 , interval

90− , intervalOid

9156 , timetz

92− , timetzOid

9357 , bit

94− , bitOid

9558 , varbit

96− , varbitOid

9759 , numeric

98− , numericOid

9960 , refcursor

100− , refcursorOid

10161 , record

102− , recordOid

10362 , void

104− , voidOid

10563 , array_record

106− , array_recordOid

10764 , regprocedure

108− , regprocedureOid

10965 , regoper

110− , regoperOid

11166 , regoperator

112− , regoperatorOid

11367 , regclass

114− , regclassOid

11568 , regtype

116− , regtypeOid

11769 , uuid

118− , uuidOid

11970 , json

120− , jsonOid

12171 , jsonb

122− , jsonbOid

12372 , int2vector

124− , int2vectorOid

12573 , oidvector

126− , oidvectorOid

12774 , array_xml

128− , array_xmlOid

12975 , array_json

130− , array_jsonOid

13176 , array_line

132− , array_lineOid

13377 , array_cidr

134− , array_cidrOid

13578 , array_circle

136− , array_circleOid

13779 , array_money

138− , array_moneyOid

13980 , array_bool

140− , array_boolOid

14181 , array_bytea

142− , array_byteaOid

14382 , array_char

144− , array_charOid

14583 , array_name

146− , array_nameOid

14784 , array_int2

148− , array_int2Oid

14985 , array_int2vector

150− , array_int2vectorOid

15186 , array_int4

152− , array_int4Oid

15387 , array_regproc

154− , array_regprocOid

15588 , array_text

156− , array_textOid

15789 , array_tid

158− , array_tidOid

15990 , array_xid

160− , array_xidOid

16191 , array_cid

162− , array_cidOid

16392 , array_oidvector

164− , array_oidvectorOid

16593 , array_bpchar

166− , array_bpcharOid

16794 , array_varchar

168− , array_varcharOid

16995 , array_int8

170− , array_int8Oid

17196 , array_point

172− , array_pointOid

17397 , array_lseg

174− , array_lsegOid

17598 , array_path

176− , array_pathOid

17799 , array_box

178− , array_boxOid

179100 , array_float4

180− , array_float4Oid

181101 , array_float8

182− , array_float8Oid

183102 , array_polygon

184− , array_polygonOid

185103 , array_oid

186− , array_oidOid

187104 , array_macaddr

188− , array_macaddrOid

189105 , array_inet

190− , array_inetOid

191106 , array_timestamp

192− , array_timestampOid

193107 , array_date

194− , array_dateOid

195108 , array_time

196− , array_timeOid

197109 , array_timestamptz

198− , array_timestamptzOid

199110 , array_interval

200− , array_intervalOid

201111 , array_numeric

202− , array_numericOid

203112 , array_timetz

204− , array_timetzOid

205113 , array_bit

206− , array_bitOid

207114 , array_varbit

208− , array_varbitOid

209115 , array_refcursor

210− , array_refcursorOid

211116 , array_regprocedure

212− , array_regprocedureOid

213117 , array_regoper

214− , array_regoperOid

215118 , array_regoperator

216− , array_regoperatorOid

217119 , array_regclass

218− , array_regclassOid

219120 , array_regtype

220− , array_regtypeOid

221121 , array_uuid

222− , array_uuidOid

223122 , array_jsonb

224− , array_jsonbOid

225123 , int4range

226− , int4rangeOid

227124 , _int4range

228− , _int4rangeOid

229125 , numrange

230− , numrangeOid

231126 , _numrange

232− , _numrangeOid

233127 , tsrange

234− , tsrangeOid

235128 , _tsrange

236− , _tsrangeOid

237129 , tstzrange

238− , tstzrangeOid

239130 , _tstzrange

240− , _tstzrangeOid

241131 , daterange

242− , daterangeOid

243132 , _daterange

244− , _daterangeOid

245133 , int8range

246− , int8rangeOid

247134 , _int8range

248− , _int8rangeOid

249135 ) where

250136

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

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

371257

372258bool :: TypeInfo

373259bool = Basic {

374− typoid = boolOid,

260+ typoid = Oid 16,

375261 typcategory = 'B',

376262 typdelim = ',',

377263 typname = "bool"

378264 }

379265

380−boolOid :: Oid

381−boolOid = Oid 16

382−{-# INLINE boolOid #-}

383−

384266bytea :: TypeInfo

385267bytea = Basic {

386− typoid = byteaOid,

268+ typoid = Oid 17,

387269 typcategory = 'U',

388270 typdelim = ',',

389271 typname = "bytea"

390272 }

391273

392−byteaOid :: Oid

393−byteaOid = Oid 17

394−{-# INLINE byteaOid #-}

395−

396274char :: TypeInfo

397275char = Basic {

398− typoid = charOid,

276+ typoid = Oid 18,

399277 typcategory = 'S',

400278 typdelim = ',',

401279 typname = "char"

402280 }

403281

404−charOid :: Oid

405−charOid = Oid 18

406−{-# INLINE charOid #-}

407−

408282name :: TypeInfo

409283name = Basic {

410− typoid = nameOid,

284+ typoid = Oid 19,

411285 typcategory = 'S',

412286 typdelim = ',',

413287 typname = "name"

414288 }

415289

416−nameOid :: Oid

417−nameOid = Oid 19

418−{-# INLINE nameOid #-}

419−

420290int8 :: TypeInfo

421291int8 = Basic {

422− typoid = int8Oid,

292+ typoid = Oid 20,

423293 typcategory = 'N',

424294 typdelim = ',',

425295 typname = "int8"

426296 }

427297

428−int8Oid :: Oid

429−int8Oid = Oid 20

430−{-# INLINE int8Oid #-}

431−

432298int2 :: TypeInfo

433299int2 = Basic {

434− typoid = int2Oid,

300+ typoid = Oid 21,

435301 typcategory = 'N',

436302 typdelim = ',',

437303 typname = "int2"

438304 }

439305

440−int2Oid :: Oid

441−int2Oid = Oid 21

442−{-# INLINE int2Oid #-}

443−

444306int4 :: TypeInfo

445307int4 = Basic {

446− typoid = int4Oid,

308+ typoid = Oid 23,

447309 typcategory = 'N',

448310 typdelim = ',',

449311 typname = "int4"

450312 }

451313

452−int4Oid :: Oid

453−int4Oid = Oid 23

454−{-# INLINE int4Oid #-}

455−

456314regproc :: TypeInfo

457315regproc = Basic {

458− typoid = regprocOid,

316+ typoid = Oid 24,

459317 typcategory = 'N',

460318 typdelim = ',',

461319 typname = "regproc"

462320 }

463321

464−regprocOid :: Oid

465−regprocOid = Oid 24

466−{-# INLINE regprocOid #-}

467−

468322text :: TypeInfo

469323text = Basic {

470− typoid = textOid,

324+ typoid = Oid 25,

471325 typcategory = 'S',

472326 typdelim = ',',

473327 typname = "text"

474328 }

475329

476−textOid :: Oid

477−textOid = Oid 25

478−{-# INLINE textOid #-}

479−

480330oid :: TypeInfo

481331oid = Basic {

482− typoid = oidOid,

332+ typoid = Oid 26,

483333 typcategory = 'N',

484334 typdelim = ',',

485335 typname = "oid"

486336 }

487337

488−oidOid :: Oid

489−oidOid = Oid 26

490−{-# INLINE oidOid #-}

491−

492338tid :: TypeInfo

493339tid = Basic {

494− typoid = tidOid,

340+ typoid = Oid 27,

495341 typcategory = 'U',

496342 typdelim = ',',

497343 typname = "tid"

498344 }

499345

500−tidOid :: Oid

501−tidOid = Oid 27

502−{-# INLINE tidOid #-}

503−

504346xid :: TypeInfo

505347xid = Basic {

506− typoid = xidOid,

348+ typoid = Oid 28,

507349 typcategory = 'U',

508350 typdelim = ',',

509351 typname = "xid"

510352 }

511353

512−xidOid :: Oid

513−xidOid = Oid 28

514−{-# INLINE xidOid #-}

515−

516354cid :: TypeInfo

517355cid = Basic {

518− typoid = cidOid,

356+ typoid = Oid 29,

519357 typcategory = 'U',

520358 typdelim = ',',

521359 typname = "cid"

522360 }

523361

524−cidOid :: Oid

525−cidOid = Oid 29

526−{-# INLINE cidOid #-}

527−

528362xml :: TypeInfo

529363xml = Basic {

530− typoid = xmlOid,

364+ typoid = Oid 142,

531365 typcategory = 'U',

532366 typdelim = ',',

533367 typname = "xml"

534368 }

535369

536−xmlOid :: Oid

537−xmlOid = Oid 142

538−{-# INLINE xmlOid #-}

539−

540370point :: TypeInfo

541371point = Basic {

542− typoid = pointOid,

372+ typoid = Oid 600,

543373 typcategory = 'G',

544374 typdelim = ',',

545375 typname = "point"

546376 }

547377

548−pointOid :: Oid

549−pointOid = Oid 600

550−{-# INLINE pointOid #-}

551−

552378lseg :: TypeInfo

553379lseg = Basic {

554− typoid = lsegOid,

380+ typoid = Oid 601,

555381 typcategory = 'G',

556382 typdelim = ',',

557383 typname = "lseg"

558384 }

559385

560−lsegOid :: Oid

561−lsegOid = Oid 601

562−{-# INLINE lsegOid #-}

563−

564386path :: TypeInfo

565387path = Basic {

566− typoid = pathOid,

388+ typoid = Oid 602,

567389 typcategory = 'G',

568390 typdelim = ',',

569391 typname = "path"

570392 }

571393

572−pathOid :: Oid

573−pathOid = Oid 602

574−{-# INLINE pathOid #-}

575−

576394box :: TypeInfo

577395box = Basic {

578− typoid = boxOid,

396+ typoid = Oid 603,

579397 typcategory = 'G',

580398 typdelim = ';',

581399 typname = "box"

582400 }

583401

584−boxOid :: Oid

585−boxOid = Oid 603

586−{-# INLINE boxOid #-}

587−

588402polygon :: TypeInfo

589403polygon = Basic {

590− typoid = polygonOid,

404+ typoid = Oid 604,

591405 typcategory = 'G',

592406 typdelim = ',',

593407 typname = "polygon"

594408 }

595409

596−polygonOid :: Oid

597−polygonOid = Oid 604

598−{-# INLINE polygonOid #-}

599−

600410line :: TypeInfo

601411line = Basic {

602− typoid = lineOid,

412+ typoid = Oid 628,

603413 typcategory = 'G',

604414 typdelim = ',',

605415 typname = "line"

606416 }

607417

608−lineOid :: Oid

609−lineOid = Oid 628

610−{-# INLINE lineOid #-}

611−

612418cidr :: TypeInfo

613419cidr = Basic {

614− typoid = cidrOid,

420+ typoid = Oid 650,

615421 typcategory = 'I',

616422 typdelim = ',',

617423 typname = "cidr"

618424 }

619425

620−cidrOid :: Oid

621−cidrOid = Oid 650

622−{-# INLINE cidrOid #-}

623−

624426float4 :: TypeInfo

625427float4 = Basic {

626− typoid = float4Oid,

428+ typoid = Oid 700,

627429 typcategory = 'N',

628430 typdelim = ',',

629431 typname = "float4"

630432 }

631433

632−float4Oid :: Oid

633−float4Oid = Oid 700

634−{-# INLINE float4Oid #-}

635−

636434float8 :: TypeInfo

637435float8 = Basic {

638− typoid = float8Oid,

436+ typoid = Oid 701,

639437 typcategory = 'N',

640438 typdelim = ',',

641439 typname = "float8"

642440 }

643441

644−float8Oid :: Oid

645−float8Oid = Oid 701

646−{-# INLINE float8Oid #-}

647−

648442unknown :: TypeInfo

649443unknown = Basic {

650− typoid = unknownOid,

444+ typoid = Oid 705,

651445 typcategory = 'X',

652446 typdelim = ',',

653447 typname = "unknown"

654448 }

655449

656−unknownOid :: Oid

657−unknownOid = Oid 705

658−{-# INLINE unknownOid #-}

659−

660450circle :: TypeInfo

661451circle = Basic {

662− typoid = circleOid,

452+ typoid = Oid 718,

663453 typcategory = 'G',

664454 typdelim = ',',

665455 typname = "circle"

666456 }

667457

668−circleOid :: Oid

669−circleOid = Oid 718

670−{-# INLINE circleOid #-}

671−

672458money :: TypeInfo

673459money = Basic {

674− typoid = moneyOid,

460+ typoid = Oid 790,

675461 typcategory = 'N',

676462 typdelim = ',',

677463 typname = "money"

678464 }

679465

680−moneyOid :: Oid

681−moneyOid = Oid 790

682−{-# INLINE moneyOid #-}

683−

684466macaddr :: TypeInfo

685467macaddr = Basic {

686− typoid = macaddrOid,

468+ typoid = Oid 829,

687469 typcategory = 'U',

688470 typdelim = ',',

689471 typname = "macaddr"

690472 }

691473

692−macaddrOid :: Oid

693−macaddrOid = Oid 829

694−{-# INLINE macaddrOid #-}

695−

696474inet :: TypeInfo

697475inet = Basic {

698− typoid = inetOid,

476+ typoid = Oid 869,

699477 typcategory = 'I',

700478 typdelim = ',',

701479 typname = "inet"

702480 }

703481

704−inetOid :: Oid

705−inetOid = Oid 869

706−{-# INLINE inetOid #-}

707−

708482bpchar :: TypeInfo

709483bpchar = Basic {

710− typoid = bpcharOid,

484+ typoid = Oid 1042,

711485 typcategory = 'S',

712486 typdelim = ',',

713487 typname = "bpchar"

714488 }

715489

716−bpcharOid :: Oid

717−bpcharOid = Oid 1042

718−{-# INLINE bpcharOid #-}

719−

720490varchar :: TypeInfo

721491varchar = Basic {

722− typoid = varcharOid,

492+ typoid = Oid 1043,

723493 typcategory = 'S',

724494 typdelim = ',',

725495 typname = "varchar"

726496 }

727497

728−varcharOid :: Oid

729−varcharOid = Oid 1043

730−{-# INLINE varcharOid #-}

731−

732498date :: TypeInfo

733499date = Basic {

734− typoid = dateOid,

500+ typoid = Oid 1082,

735501 typcategory = 'D',

736502 typdelim = ',',

737503 typname = "date"

738504 }

739505

740−dateOid :: Oid

741−dateOid = Oid 1082

742−{-# INLINE dateOid #-}

743−

744506time :: TypeInfo

745507time = Basic {

746− typoid = timeOid,

508+ typoid = Oid 1083,

747509 typcategory = 'D',

748510 typdelim = ',',

749511 typname = "time"

750512 }

751513

752−timeOid :: Oid

753−timeOid = Oid 1083

754−{-# INLINE timeOid #-}

755−

756514timestamp :: TypeInfo

757515timestamp = Basic {

758− typoid = timestampOid,

516+ typoid = Oid 1114,

759517 typcategory = 'D',

760518 typdelim = ',',

761519 typname = "timestamp"

762520 }

763521

764−timestampOid :: Oid

765−timestampOid = Oid 1114

766−{-# INLINE timestampOid #-}

767−

768522timestamptz :: TypeInfo

769523timestamptz = Basic {

770− typoid = timestamptzOid,

524+ typoid = Oid 1184,

771525 typcategory = 'D',

772526 typdelim = ',',

773527 typname = "timestamptz"

774528 }

775529

776−timestamptzOid :: Oid

777−timestamptzOid = Oid 1184

778−{-# INLINE timestamptzOid #-}

779−

780530interval :: TypeInfo

781531interval = Basic {

782− typoid = intervalOid,

532+ typoid = Oid 1186,

783533 typcategory = 'T',

784534 typdelim = ',',

785535 typname = "interval"

786536 }

787537

788−intervalOid :: Oid

789−intervalOid = Oid 1186

790−{-# INLINE intervalOid #-}

791−

792538timetz :: TypeInfo

793539timetz = Basic {

794− typoid = timetzOid,

540+ typoid = Oid 1266,

795541 typcategory = 'D',

796542 typdelim = ',',

797543 typname = "timetz"

798544 }

799545

800−timetzOid :: Oid

801−timetzOid = Oid 1266

802−{-# INLINE timetzOid #-}

803−

804546bit :: TypeInfo

805547bit = Basic {

806− typoid = bitOid,

548+ typoid = Oid 1560,

807549 typcategory = 'V',

808550 typdelim = ',',

809551 typname = "bit"

810552 }

811553

812−bitOid :: Oid

813−bitOid = Oid 1560

814−{-# INLINE bitOid #-}

815−

816554varbit :: TypeInfo

817555varbit = Basic {

818− typoid = varbitOid,

556+ typoid = Oid 1562,

819557 typcategory = 'V',

820558 typdelim = ',',

821559 typname = "varbit"

822560 }

823561

824−varbitOid :: Oid

825−varbitOid = Oid 1562

826−{-# INLINE varbitOid #-}

827−

828562numeric :: TypeInfo

829563numeric = Basic {

830− typoid = numericOid,

564+ typoid = Oid 1700,

831565 typcategory = 'N',

832566 typdelim = ',',

833567 typname = "numeric"

834568 }

835569

836−numericOid :: Oid

837−numericOid = Oid 1700

838−{-# INLINE numericOid #-}

839−

840570refcursor :: TypeInfo

841571refcursor = Basic {

842− typoid = refcursorOid,

572+ typoid = Oid 1790,

843573 typcategory = 'U',

844574 typdelim = ',',

845575 typname = "refcursor"

846576 }

847577

848−refcursorOid :: Oid

849−refcursorOid = Oid 1790

850−{-# INLINE refcursorOid #-}

851−

852578record :: TypeInfo

853579record = Basic {

854− typoid = recordOid,

580+ typoid = Oid 2249,

855581 typcategory = 'P',

856582 typdelim = ',',

857583 typname = "record"

858584 }

859585

860−recordOid :: Oid

861−recordOid = Oid 2249

862−{-# INLINE recordOid #-}

863−

864586void :: TypeInfo

865587void = Basic {

866− typoid = voidOid,

588+ typoid = Oid 2278,

867589 typcategory = 'P',

868590 typdelim = ',',

869591 typname = "void"

870592 }

871593

872−voidOid :: Oid

873−voidOid = Oid 2278

874−{-# INLINE voidOid #-}

875−

876594array_record :: TypeInfo

877595array_record = Array {

878− typoid = array_recordOid,

596+ typoid = Oid 2287,

879597 typcategory = 'P',

880598 typdelim = ',',

881599 typname = "_record",

882600 typelem = record

883601 }

884602

885−array_recordOid :: Oid

886−array_recordOid = Oid 2287

887−{-# INLINE array_recordOid #-}

888−

889603regprocedure :: TypeInfo

890604regprocedure = Basic {

891− typoid = regprocedureOid,

605+ typoid = Oid 2202,

892606 typcategory = 'N',

893607 typdelim = ',',

894608 typname = "regprocedure"

895609 }

896610

897−regprocedureOid :: Oid

898−regprocedureOid = Oid 2202

899−{-# INLINE regprocedureOid #-}

900−

901611regoper :: TypeInfo

902612regoper = Basic {

903− typoid = regoperOid,

613+ typoid = Oid 2203,

904614 typcategory = 'N',

905615 typdelim = ',',

906616 typname = "regoper"

907617 }

908618

909−regoperOid :: Oid

910−regoperOid = Oid 2203

911−{-# INLINE regoperOid #-}

912−

913619regoperator :: TypeInfo

914620regoperator = Basic {

915− typoid = regoperatorOid,

621+ typoid = Oid 2204,

916622 typcategory = 'N',

917623 typdelim = ',',

918624 typname = "regoperator"

919625 }

920626

921−regoperatorOid :: Oid

922−regoperatorOid = Oid 2204

923−{-# INLINE regoperatorOid #-}

924−

925627regclass :: TypeInfo

926628regclass = Basic {

927− typoid = regclassOid,

629+ typoid = Oid 2205,

928630 typcategory = 'N',

929631 typdelim = ',',

930632 typname = "regclass"

931633 }

932634

933−regclassOid :: Oid

934−regclassOid = Oid 2205

935−{-# INLINE regclassOid #-}

936−

937635regtype :: TypeInfo

938636regtype = Basic {

939− typoid = regtypeOid,

637+ typoid = Oid 2206,

940638 typcategory = 'N',

941639 typdelim = ',',

942640 typname = "regtype"

943641 }

944642

945−regtypeOid :: Oid

946−regtypeOid = Oid 2206

947−{-# INLINE regtypeOid #-}

948−

949643uuid :: TypeInfo

950644uuid = Basic {

951− typoid = uuidOid,

645+ typoid = Oid 2950,

952646 typcategory = 'U',

953647 typdelim = ',',

954648 typname = "uuid"

955649 }

956650

957−uuidOid :: Oid

958−uuidOid = Oid 2950

959−{-# INLINE uuidOid #-}

960−

961651json :: TypeInfo

962652json = Basic {

963− typoid = jsonOid,

653+ typoid = Oid 114,

964654 typcategory = 'U',

965655 typdelim = ',',

966656 typname = "json"

967657 }

968658

969−jsonOid :: Oid

970−jsonOid = Oid 114

971−{-# INLINE jsonOid #-}

972−

973659jsonb :: TypeInfo

974660jsonb = Basic {

975− typoid = jsonbOid,

661+ typoid = Oid 3802,

976662 typcategory = 'U',

977663 typdelim = ',',

978664 typname = "jsonb"

979665 }

980666

981−jsonbOid :: Oid

982−jsonbOid = Oid 3802

983−{-# INLINE jsonbOid #-}

984−

985667int2vector :: TypeInfo

986668int2vector = Array {

987− typoid = int2vectorOid,

669+ typoid = Oid 22,

988670 typcategory = 'A',

989671 typdelim = ',',

990672 typname = "int2vector",

991673 typelem = int2

992674 }

993675

994−int2vectorOid :: Oid

995−int2vectorOid = Oid 22

996−{-# INLINE int2vectorOid #-}

997−

998676oidvector :: TypeInfo

999677oidvector = Array {

1000− typoid = oidvectorOid,

678+ typoid = Oid 30,

1001679 typcategory = 'A',

1002680 typdelim = ',',

1003681 typname = "oidvector",

1004682 typelem = oid

1005683 }

1006684

1007−oidvectorOid :: Oid

1008−oidvectorOid = Oid 30

1009−{-# INLINE oidvectorOid #-}

1010−

1011685array_xml :: TypeInfo

1012686array_xml = Array {

1013− typoid = array_xmlOid,

687+ typoid = Oid 143,

1014688 typcategory = 'A',

1015689 typdelim = ',',

1016690 typname = "_xml",

1017691 typelem = xml

1018692 }

1019693

1020−array_xmlOid :: Oid

1021−array_xmlOid = Oid 143

1022−{-# INLINE array_xmlOid #-}

1023−

1024694array_json :: TypeInfo

1025695array_json = Array {

1026− typoid = array_jsonOid,

696+ typoid = Oid 199,

1027697 typcategory = 'A',

1028698 typdelim = ',',

1029699 typname = "_json",

1030700 typelem = json

1031701 }

1032702

1033−array_jsonOid :: Oid

1034−array_jsonOid = Oid 199

1035−{-# INLINE array_jsonOid #-}

1036−

1037703array_line :: TypeInfo

1038704array_line = Array {

1039− typoid = array_lineOid,

705+ typoid = Oid 629,

1040706 typcategory = 'A',

1041707 typdelim = ',',

1042708 typname = "_line",

1043709 typelem = line

1044710 }

1045711

1046−array_lineOid :: Oid

1047−array_lineOid = Oid 629

1048−{-# INLINE array_lineOid #-}

1049−

1050712array_cidr :: TypeInfo

1051713array_cidr = Array {

1052− typoid = array_cidrOid,

714+ typoid = Oid 651,

1053715 typcategory = 'A',

1054716 typdelim = ',',

1055717 typname = "_cidr",

1056718 typelem = cidr

1057719 }

1058720

1059−array_cidrOid :: Oid

1060−array_cidrOid = Oid 651

1061−{-# INLINE array_cidrOid #-}

1062−

1063721array_circle :: TypeInfo

1064722array_circle = Array {

1065− typoid = array_circleOid,

723+ typoid = Oid 719,

1066724 typcategory = 'A',

1067725 typdelim = ',',

1068726 typname = "_circle",

1069727 typelem = circle

1070728 }

1071729

1072−array_circleOid :: Oid

1073−array_circleOid = Oid 719

1074−{-# INLINE array_circleOid #-}

1075−

1076730array_money :: TypeInfo

1077731array_money = Array {

1078− typoid = array_moneyOid,

732+ typoid = Oid 791,

1079733 typcategory = 'A',

1080734 typdelim = ',',

1081735 typname = "_money",

1082736 typelem = money

1083737 }

1084738

1085−array_moneyOid :: Oid

1086−array_moneyOid = Oid 791

1087−{-# INLINE array_moneyOid #-}

1088−

1089739array_bool :: TypeInfo

1090740array_bool = Array {

1091− typoid = array_boolOid,

741+ typoid = Oid 1000,

1092742 typcategory = 'A',

1093743 typdelim = ',',

1094744 typname = "_bool",

1095745 typelem = bool

1096746 }

1097747

1098−array_boolOid :: Oid

1099−array_boolOid = Oid 1000

1100−{-# INLINE array_boolOid #-}

1101−

1102748array_bytea :: TypeInfo

1103749array_bytea = Array {

1104− typoid = array_byteaOid,

750+ typoid = Oid 1001,

1105751 typcategory = 'A',

1106752 typdelim = ',',

1107753 typname = "_bytea",

1108754 typelem = bytea

1109755 }

1110756

1111−array_byteaOid :: Oid

1112−array_byteaOid = Oid 1001

1113−{-# INLINE array_byteaOid #-}

1114−

1115757array_char :: TypeInfo

1116758array_char = Array {

1117− typoid = array_charOid,

759+ typoid = Oid 1002,

1118760 typcategory = 'A',

1119761 typdelim = ',',

1120762 typname = "_char",

1121763 typelem = char

1122764 }

1123765

1124−array_charOid :: Oid

1125−array_charOid = Oid 1002

1126−{-# INLINE array_charOid #-}

1127−

1128766array_name :: TypeInfo

1129767array_name = Array {

1130− typoid = array_nameOid,

768+ typoid = Oid 1003,

1131769 typcategory = 'A',

1132770 typdelim = ',',

1133771 typname = "_name",

1134772 typelem = name

1135773 }

1136774

1137−array_nameOid :: Oid

1138−array_nameOid = Oid 1003

1139−{-# INLINE array_nameOid #-}

1140−

1141775array_int2 :: TypeInfo

1142776array_int2 = Array {

1143− typoid = array_int2Oid,

777+ typoid = Oid 1005,

1144778 typcategory = 'A',

1145779 typdelim = ',',

1146780 typname = "_int2",

1147781 typelem = int2

1148782 }

1149783

1150−array_int2Oid :: Oid

1151−array_int2Oid = Oid 1005

1152−{-# INLINE array_int2Oid #-}

1153−

1154784array_int2vector :: TypeInfo

1155785array_int2vector = Array {

1156− typoid = array_int2vectorOid,

786+ typoid = Oid 1006,

1157787 typcategory = 'A',

1158788 typdelim = ',',

1159789 typname = "_int2vector",

1160790 typelem = int2vector

1161791 }

1162792

1163−array_int2vectorOid :: Oid

1164−array_int2vectorOid = Oid 1006

1165−{-# INLINE array_int2vectorOid #-}

1166−

1167793array_int4 :: TypeInfo

1168794array_int4 = Array {

1169− typoid = array_int4Oid,

795+ typoid = Oid 1007,

1170796 typcategory = 'A',

1171797 typdelim = ',',

1172798 typname = "_int4",

1173799 typelem = int4

1174800 }

1175801

1176−array_int4Oid :: Oid

1177−array_int4Oid = Oid 1007

1178−{-# INLINE array_int4Oid #-}

1179−

1180802array_regproc :: TypeInfo

1181803array_regproc = Array {

1182− typoid = array_regprocOid,

804+ typoid = Oid 1008,

1183805 typcategory = 'A',

1184806 typdelim = ',',

1185807 typname = "_regproc",

1186808 typelem = regproc

1187809 }

1188810

1189−array_regprocOid :: Oid

1190−array_regprocOid = Oid 1008

1191−{-# INLINE array_regprocOid #-}

1192−

1193811array_text :: TypeInfo

1194812array_text = Array {

1195− typoid = array_textOid,

813+ typoid = Oid 1009,

1196814 typcategory = 'A',

1197815 typdelim = ',',

1198816 typname = "_text",

1199817 typelem = text

1200818 }

1201819

1202−array_textOid :: Oid

1203−array_textOid = Oid 1009

1204−{-# INLINE array_textOid #-}

1205−

1206820array_tid :: TypeInfo

1207821array_tid = Array {

1208− typoid = array_tidOid,

822+ typoid = Oid 1010,

1209823 typcategory = 'A',

1210824 typdelim = ',',

1211825 typname = "_tid",

1212826 typelem = tid

1213827 }

1214828

1215−array_tidOid :: Oid

1216−array_tidOid = Oid 1010

1217−{-# INLINE array_tidOid #-}

1218−

1219829array_xid :: TypeInfo

1220830array_xid = Array {

1221− typoid = array_xidOid,

831+ typoid = Oid 1011,

1222832 typcategory = 'A',

1223833 typdelim = ',',

1224834 typname = "_xid",

1225835 typelem = xid

1226836 }

1227837

1228−array_xidOid :: Oid

1229−array_xidOid = Oid 1011

1230−{-# INLINE array_xidOid #-}

1231−

1232838array_cid :: TypeInfo

1233839array_cid = Array {

1234− typoid = array_cidOid,

840+ typoid = Oid 1012,

1235841 typcategory = 'A',

1236842 typdelim = ',',

1237843 typname = "_cid",

1238844 typelem = cid

1239845 }

1240846

1241−array_cidOid :: Oid

1242−array_cidOid = Oid 1012

1243−{-# INLINE array_cidOid #-}

1244−

1245847array_oidvector :: TypeInfo

1246848array_oidvector = Array {

1247− typoid = array_oidvectorOid,

849+ typoid = Oid 1013,

1248850 typcategory = 'A',

1249851 typdelim = ',',

1250852 typname = "_oidvector",

1251853 typelem = oidvector

1252854 }

1253855

1254−array_oidvectorOid :: Oid

1255−array_oidvectorOid = Oid 1013

1256−{-# INLINE array_oidvectorOid #-}

1257−

1258856array_bpchar :: TypeInfo

1259857array_bpchar = Array {

1260− typoid = array_bpcharOid,

858+ typoid = Oid 1014,

1261859 typcategory = 'A',

1262860 typdelim = ',',

1263861 typname = "_bpchar",

1264862 typelem = bpchar

1265863 }

1266864

1267−array_bpcharOid :: Oid

1268−array_bpcharOid = Oid 1014

1269−{-# INLINE array_bpcharOid #-}

1270−

1271865array_varchar :: TypeInfo

1272866array_varchar = Array {

1273− typoid = array_varcharOid,

867+ typoid = Oid 1015,

1274868 typcategory = 'A',

1275869 typdelim = ',',

1276870 typname = "_varchar",

1277871 typelem = varchar

1278872 }

1279873

1280−array_varcharOid :: Oid

1281−array_varcharOid = Oid 1015

1282−{-# INLINE array_varcharOid #-}

1283−

1284874array_int8 :: TypeInfo

1285875array_int8 = Array {

1286− typoid = array_int8Oid,

876+ typoid = Oid 1016,

1287877 typcategory = 'A',

1288878 typdelim = ',',

1289879 typname = "_int8",

1290880 typelem = int8

1291881 }

1292882

1293−array_int8Oid :: Oid

1294−array_int8Oid = Oid 1016

1295−{-# INLINE array_int8Oid #-}

1296−

1297883array_point :: TypeInfo

1298884array_point = Array {

1299− typoid = array_pointOid,

885+ typoid = Oid 1017,

1300886 typcategory = 'A',

1301887 typdelim = ',',

1302888 typname = "_point",

1303889 typelem = point

1304890 }

1305891

1306−array_pointOid :: Oid

1307−array_pointOid = Oid 1017

1308−{-# INLINE array_pointOid #-}

1309−

1310892array_lseg :: TypeInfo

1311893array_lseg = Array {

1312− typoid = array_lsegOid,

894+ typoid = Oid 1018,

1313895 typcategory = 'A',

1314896 typdelim = ',',

1315897 typname = "_lseg",

1316898 typelem = lseg

1317899 }

1318900

1319−array_lsegOid :: Oid

1320−array_lsegOid = Oid 1018

1321−{-# INLINE array_lsegOid #-}

1322−

1323901array_path :: TypeInfo

1324902array_path = Array {

1325− typoid = array_pathOid,

903+ typoid = Oid 1019,

1326904 typcategory = 'A',

1327905 typdelim = ',',

1328906 typname = "_path",

1329907 typelem = path

1330908 }

1331909

1332−array_pathOid :: Oid

1333−array_pathOid = Oid 1019

1334−{-# INLINE array_pathOid #-}

1335−

1336910array_box :: TypeInfo

1337911array_box = Array {

1338− typoid = array_boxOid,

912+ typoid = Oid 1020,

1339913 typcategory = 'A',

1340914 typdelim = ';',

1341915 typname = "_box",

1342916 typelem = box

1343917 }

1344918

1345−array_boxOid :: Oid

1346−array_boxOid = Oid 1020

1347−{-# INLINE array_boxOid #-}

1348−

1349919array_float4 :: TypeInfo

1350920array_float4 = Array {

1351− typoid = array_float4Oid,

921+ typoid = Oid 1021,

1352922 typcategory = 'A',

1353923 typdelim = ',',

1354924 typname = "_float4",

1355925 typelem = float4

1356926 }

1357927

1358−array_float4Oid :: Oid

1359−array_float4Oid = Oid 1021

1360−{-# INLINE array_float4Oid #-}

1361−

1362928array_float8 :: TypeInfo

1363929array_float8 = Array {

1364− typoid = array_float8Oid,

930+ typoid = Oid 1022,

1365931 typcategory = 'A',

1366932 typdelim = ',',

1367933 typname = "_float8",

1368934 typelem = float8

1369935 }

1370936

1371−array_float8Oid :: Oid

1372−array_float8Oid = Oid 1022

1373−{-# INLINE array_float8Oid #-}

1374−

1375937array_polygon :: TypeInfo

1376938array_polygon = Array {

1377− typoid = array_polygonOid,

939+ typoid = Oid 1027,

1378940 typcategory = 'A',

1379941 typdelim = ',',

1380942 typname = "_polygon",

1381943 typelem = polygon

1382944 }

1383945

1384−array_polygonOid :: Oid

1385−array_polygonOid = Oid 1027

1386−{-# INLINE array_polygonOid #-}

1387−

1388946array_oid :: TypeInfo

1389947array_oid = Array {

1390− typoid = array_oidOid,

948+ typoid = Oid 1028,

1391949 typcategory = 'A',

1392950 typdelim = ',',

1393951 typname = "_oid",

1394952 typelem = oid

1395953 }

1396954

1397−array_oidOid :: Oid

1398−array_oidOid = Oid 1028

1399−{-# INLINE array_oidOid #-}

1400−

1401955array_macaddr :: TypeInfo

1402956array_macaddr = Array {

1403− typoid = array_macaddrOid,

957+ typoid = Oid 1040,

1404958 typcategory = 'A',

1405959 typdelim = ',',

1406960 typname = "_macaddr",

1407961 typelem = macaddr

1408962 }

1409963

1410−array_macaddrOid :: Oid

1411−array_macaddrOid = Oid 1040

1412−{-# INLINE array_macaddrOid #-}

1413−

1414964array_inet :: TypeInfo

1415965array_inet = Array {

1416− typoid = array_inetOid,

966+ typoid = Oid 1041,

1417967 typcategory = 'A',

1418968 typdelim = ',',

1419969 typname = "_inet",

1420970 typelem = inet

1421971 }

1422972

1423−array_inetOid :: Oid

1424−array_inetOid = Oid 1041

1425−{-# INLINE array_inetOid #-}

1426−

1427973array_timestamp :: TypeInfo

1428974array_timestamp = Array {

1429− typoid = array_timestampOid,

975+ typoid = Oid 1115,

1430976 typcategory = 'A',

1431977 typdelim = ',',

1432978 typname = "_timestamp",

1433979 typelem = timestamp

1434980 }

1435981

1436−array_timestampOid :: Oid

1437−array_timestampOid = Oid 1115

1438−{-# INLINE array_timestampOid #-}

1439−

1440982array_date :: TypeInfo

1441983array_date = Array {

1442− typoid = array_dateOid,

984+ typoid = Oid 1182,

1443985 typcategory = 'A',

1444986 typdelim = ',',

1445987 typname = "_date",

1446988 typelem = date

1447989 }

1448990

1449−array_dateOid :: Oid

1450−array_dateOid = Oid 1182

1451−{-# INLINE array_dateOid #-}

1452−

1453991array_time :: TypeInfo

1454992array_time = Array {

1455− typoid = array_timeOid,

993+ typoid = Oid 1183,

1456994 typcategory = 'A',

1457995 typdelim = ',',

1458996 typname = "_time",

1459997 typelem = time

1460998 }

1461999

1462−array_timeOid :: Oid

1463−array_timeOid = Oid 1183

1464−{-# INLINE array_timeOid #-}

1465−

14661000array_timestamptz :: TypeInfo

14671001array_timestamptz = Array {

1468− typoid = array_timestamptzOid,

1002+ typoid = Oid 1185,

14691003 typcategory = 'A',

14701004 typdelim = ',',

14711005 typname = "_timestamptz",

14721006 typelem = timestamptz

14731007 }

14741008

1475−array_timestamptzOid :: Oid

1476−array_timestamptzOid = Oid 1185

1477−{-# INLINE array_timestamptzOid #-}

1478−

14791009array_interval :: TypeInfo

14801010array_interval = Array {

1481− typoid = array_intervalOid,

1011+ typoid = Oid 1187,

14821012 typcategory = 'A',

14831013 typdelim = ',',

14841014 typname = "_interval",

14851015 typelem = interval

14861016 }

14871017

1488−array_intervalOid :: Oid

1489−array_intervalOid = Oid 1187

1490−{-# INLINE array_intervalOid #-}

1491−

14921018array_numeric :: TypeInfo

14931019array_numeric = Array {

1494− typoid = array_numericOid,

1020+ typoid = Oid 1231,

14951021 typcategory = 'A',

14961022 typdelim = ',',

14971023 typname = "_numeric",

14981024 typelem = numeric

14991025 }

15001026

1501−array_numericOid :: Oid

1502−array_numericOid = Oid 1231

1503−{-# INLINE array_numericOid #-}

1504−

15051027array_timetz :: TypeInfo

15061028array_timetz = Array {

1507− typoid = array_timetzOid,

1029+ typoid = Oid 1270,

15081030 typcategory = 'A',

15091031 typdelim = ',',

15101032 typname = "_timetz",

15111033 typelem = timetz

15121034 }

15131035

1514−array_timetzOid :: Oid

1515−array_timetzOid = Oid 1270

1516−{-# INLINE array_timetzOid #-}

1517−

15181036array_bit :: TypeInfo

15191037array_bit = Array {

1520− typoid = array_bitOid,

1038+ typoid = Oid 1561,

15211039 typcategory = 'A',

15221040 typdelim = ',',

15231041 typname = "_bit",

15241042 typelem = bit

15251043 }

15261044

1527−array_bitOid :: Oid

1528−array_bitOid = Oid 1561

1529−{-# INLINE array_bitOid #-}

1530−

15311045array_varbit :: TypeInfo

15321046array_varbit = Array {

1533− typoid = array_varbitOid,

1047+ typoid = Oid 1563,

15341048 typcategory = 'A',

15351049 typdelim = ',',

15361050 typname = "_varbit",

15371051 typelem = varbit

15381052 }

15391053

1540−array_varbitOid :: Oid

1541−array_varbitOid = Oid 1563

1542−{-# INLINE array_varbitOid #-}

1543−

15441054array_refcursor :: TypeInfo

15451055array_refcursor = Array {

1546− typoid = array_refcursorOid,

1056+ typoid = Oid 2201,

15471057 typcategory = 'A',

15481058 typdelim = ',',

15491059 typname = "_refcursor",

15501060 typelem = refcursor

15511061 }

15521062

1553−array_refcursorOid :: Oid

1554−array_refcursorOid = Oid 2201

1555−{-# INLINE array_refcursorOid #-}

1556−

15571063array_regprocedure :: TypeInfo

15581064array_regprocedure = Array {

1559− typoid = array_regprocedureOid,

1065+ typoid = Oid 2207,

15601066 typcategory = 'A',

15611067 typdelim = ',',

15621068 typname = "_regprocedure",

15631069 typelem = regprocedure

15641070 }

15651071

1566−array_regprocedureOid :: Oid

1567−array_regprocedureOid = Oid 2207

1568−{-# INLINE array_regprocedureOid #-}

1569−

15701072array_regoper :: TypeInfo

15711073array_regoper = Array {

1572− typoid = array_regoperOid,

1074+ typoid = Oid 2208,

15731075 typcategory = 'A',

15741076 typdelim = ',',

15751077 typname = "_regoper",

15761078 typelem = regoper

15771079 }

15781080

1579−array_regoperOid :: Oid

1580−array_regoperOid = Oid 2208

1581−{-# INLINE array_regoperOid #-}

1582−

15831081array_regoperator :: TypeInfo

15841082array_regoperator = Array {

1585− typoid = array_regoperatorOid,

1083+ typoid = Oid 2209,

15861084 typcategory = 'A',

15871085 typdelim = ',',

15881086 typname = "_regoperator",

15891087 typelem = regoperator

15901088 }

15911089

1592−array_regoperatorOid :: Oid

1593−array_regoperatorOid = Oid 2209

1594−{-# INLINE array_regoperatorOid #-}

1595−

15961090array_regclass :: TypeInfo

15971091array_regclass = Array {

1598− typoid = array_regclassOid,

1092+ typoid = Oid 2210,

15991093 typcategory = 'A',

16001094 typdelim = ',',

16011095 typname = "_regclass",

16021096 typelem = regclass

16031097 }

16041098

1605−array_regclassOid :: Oid

1606−array_regclassOid = Oid 2210

1607−{-# INLINE array_regclassOid #-}

1608−

16091099array_regtype :: TypeInfo

16101100array_regtype = Array {

1611− typoid = array_regtypeOid,

1101+ typoid = Oid 2211,

16121102 typcategory = 'A',

16131103 typdelim = ',',

16141104 typname = "_regtype",

16151105 typelem = regtype

16161106 }

16171107

1618−array_regtypeOid :: Oid

1619−array_regtypeOid = Oid 2211

1620−{-# INLINE array_regtypeOid #-}

1621−

16221108array_uuid :: TypeInfo

16231109array_uuid = Array {

1624− typoid = array_uuidOid,

1110+ typoid = Oid 2951,

16251111 typcategory = 'A',

16261112 typdelim = ',',

16271113 typname = "_uuid",

16281114 typelem = uuid

16291115 }

16301116

1631−array_uuidOid :: Oid

1632−array_uuidOid = Oid 2951

1633−{-# INLINE array_uuidOid #-}

1634−

16351117array_jsonb :: TypeInfo

16361118array_jsonb = Array {

1637− typoid = array_jsonbOid,

1119+ typoid = Oid 3807,

16381120 typcategory = 'A',

16391121 typdelim = ',',

16401122 typname = "_jsonb",

16411123 typelem = jsonb

16421124 }

16431125

1644−array_jsonbOid :: Oid

1645−array_jsonbOid = Oid 3807

1646−{-# INLINE array_jsonbOid #-}

1647−

16481126int4range :: TypeInfo

16491127int4range = Range {

1650− typoid = int4rangeOid,

1128+ typoid = Oid 3904,

16511129 typcategory = 'R',

16521130 typdelim = ',',

16531131 typname = "int4range",

16541132 rngsubtype = int4

16551133 }

16561134

1657−int4rangeOid :: Oid

1658−int4rangeOid = Oid 3904

1659−{-# INLINE int4rangeOid #-}

1660−

16611135_int4range :: TypeInfo

16621136_int4range = Array {

1663− typoid = _int4rangeOid,

1137+ typoid = Oid 3905,

16641138 typcategory = 'A',

16651139 typdelim = ',',

16661140 typname = "_int4range",

16671141 typelem = int4range

16681142 }

16691143

1670−_int4rangeOid :: Oid

1671−_int4rangeOid = Oid 3905

1672−{-# INLINE _int4rangeOid #-}

1673−

16741144numrange :: TypeInfo

16751145numrange = Range {

1676− typoid = numrangeOid,

1146+ typoid = Oid 3906,

16771147 typcategory = 'R',

16781148 typdelim = ',',

16791149 typname = "numrange",

16801150 rngsubtype = numeric

16811151 }

16821152

1683−numrangeOid :: Oid

1684−numrangeOid = Oid 3906

1685−{-# INLINE numrangeOid #-}

1686−

16871153_numrange :: TypeInfo

16881154_numrange = Array {

1689− typoid = _numrangeOid,

1155+ typoid = Oid 3907,

16901156 typcategory = 'A',

16911157 typdelim = ',',

16921158 typname = "_numrange",

16931159 typelem = numrange

16941160 }

16951161

1696−_numrangeOid :: Oid

1697−_numrangeOid = Oid 3907

1698−{-# INLINE _numrangeOid #-}

1699−

17001162tsrange :: TypeInfo

17011163tsrange = Range {

1702− typoid = tsrangeOid,

1164+ typoid = Oid 3908,

17031165 typcategory = 'R',

17041166 typdelim = ',',

17051167 typname = "tsrange",

17061168 rngsubtype = timestamp

17071169 }

17081170

1709−tsrangeOid :: Oid

1710−tsrangeOid = Oid 3908

1711−{-# INLINE tsrangeOid #-}

1712−

17131171_tsrange :: TypeInfo

17141172_tsrange = Array {

1715− typoid = _tsrangeOid,

1173+ typoid = Oid 3909,

17161174 typcategory = 'A',

17171175 typdelim = ',',

17181176 typname = "_tsrange",

17191177 typelem = tsrange

17201178 }

17211179

1722−_tsrangeOid :: Oid

1723−_tsrangeOid = Oid 3909

1724−{-# INLINE _tsrangeOid #-}

1725−

17261180tstzrange :: TypeInfo

17271181tstzrange = Range {

1728− typoid = tstzrangeOid,

1182+ typoid = Oid 3910,

17291183 typcategory = 'R',

17301184 typdelim = ',',

17311185 typname = "tstzrange",

17321186 rngsubtype = timestamptz

17331187 }

17341188

1735−tstzrangeOid :: Oid

1736−tstzrangeOid = Oid 3910

1737−{-# INLINE tstzrangeOid #-}

1738−

17391189_tstzrange :: TypeInfo

17401190_tstzrange = Array {

1741− typoid = _tstzrangeOid,

1191+ typoid = Oid 3911,

17421192 typcategory = 'A',

17431193 typdelim = ',',

17441194 typname = "_tstzrange",

17451195 typelem = tstzrange

17461196 }

17471197

1748−_tstzrangeOid :: Oid

1749−_tstzrangeOid = Oid 3911

1750−{-# INLINE _tstzrangeOid #-}

1751−

17521198daterange :: TypeInfo

17531199daterange = Range {

1754− typoid = daterangeOid,

1200+ typoid = Oid 3912,

17551201 typcategory = 'R',

17561202 typdelim = ',',

17571203 typname = "daterange",

17581204 rngsubtype = date

17591205 }

17601206

1761−daterangeOid :: Oid

1762−daterangeOid = Oid 3912

1763−{-# INLINE daterangeOid #-}

1764−

17651207_daterange :: TypeInfo

17661208_daterange = Array {

1767− typoid = _daterangeOid,

1209+ typoid = Oid 3913,

17681210 typcategory = 'A',

17691211 typdelim = ',',

17701212 typname = "_daterange",

17711213 typelem = daterange

17721214 }

17731215

1774−_daterangeOid :: Oid

1775−_daterangeOid = Oid 3913

1776−{-# INLINE _daterangeOid #-}

1777−

17781216int8range :: TypeInfo

17791217int8range = Range {

1780− typoid = int8rangeOid,

1218+ typoid = Oid 3926,

17811219 typcategory = 'R',

17821220 typdelim = ',',

17831221 typname = "int8range",

17841222 rngsubtype = int8

17851223 }

17861224

1787−int8rangeOid :: Oid

1788−int8rangeOid = Oid 3926

1789−{-# INLINE int8rangeOid #-}

1790−

17911225_int8range :: TypeInfo

17921226_int8range = Array {

1793− typoid = _int8rangeOid,

1227+ typoid = Oid 3927,

17941228 typcategory = 'A',

17951229 typdelim = ',',

17961230 typname = "_int8range",

17971231 typelem = int8range

17981232 }

1799−

1800−_int8rangeOid :: Oid

1801−_int8rangeOid = Oid 3927

1802−{-# INLINE _int8rangeOid #-}

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

@@ -50,6 +50,10 @@ 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+

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

5458data Default = Default

5559 deriving (Read, Show, Typeable)

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

9397

9498instance Monoid Query where

9599 mempty = Query B.empty

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

101+ mappend = (<>)

102+#endif

96103

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

98105-- single \"@?@\" character with a parenthesized list of rendered

test/Exception.hsdeleted−70

@@ -1,70 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−

5−module Exception (testExceptions) where

6−

7−import Database.PostgreSQL.Simple

8−import Test.Tasty.HUnit (Assertion, assertBool)

9−import Common (TestEnv)

10−import Control.Exception (Exception (..), SomeException)

11−import Data.Maybe (isJust)

12−import Data.Either (isLeft)

13−import Control.Exception (throwIO, try)

14−

15−testExceptions :: TestEnv -> Assertion

16−testExceptions _ = do

17− let sqlError = SqlError

18− { sqlState = ""

19− , sqlExecStatus = FatalError

20− , sqlErrorMsg = ""

21− , sqlErrorDetail = ""

22− , sqlErrorHint = ""

23− }

24− let sqlEx :: SomeException = toException sqlError

25− assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)

26− assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)

27− eSqlError :: Either SqlError () <- try $ throwIO sqlEx

28− assertBool "Can catch SqlError" $ isLeft eSqlError

29− eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx

30− assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx

31−

32− let formatError = FormatError

33− { fmtMessage = ""

34− , fmtQuery = ""

35− , fmtParams = []

36− }

37− let formatEx :: SomeException = toException formatError

38− assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)

39− assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)

40− eFormatError :: Either FormatError () <- try $ throwIO formatEx

41− assertBool "Can catch FormatError" $ isLeft eFormatError

42− eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx

43− assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx

44−

45− let queryError = QueryError

46− { qeMessage = ""

47− , qeQuery = ""

48− }

49− let queryEx :: SomeException = toException queryError

50− assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)

51− assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)

52− eQueryError :: Either QueryError () <- try $ throwIO queryEx

53− assertBool "Can catch QueryError" $ isLeft eQueryError

54− eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx

55− assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx

56−

57− let resultError = Incompatible

58− { errSQLType = ""

59− , errSQLTableOid = Nothing

60− , errSQLField = ""

61− , errHaskellType = ""

62− , errMessage = ""

63− }

64− let resultEx :: SomeException = toException resultError

65− assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)

66− assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)

67− eResultEx :: Either ResultError () <- try $ throwIO resultEx

68− assertBool "Can catch ResultError" $ isLeft eResultEx

69− eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx

70− assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx

test/Inspection.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE TemplateHaskell #-}

3−{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-module-prefixes -dsuppress-type-signatures #-}

4−-- {-# OPTIONS_GHC -dsuppress-uniques #-}

5−{-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin #-}

6−module Main where

7−

8−import Test.Inspection

9−import Test.Tasty

10−import Test.Tasty.HUnit

11−

12−import qualified Database.PostgreSQL.LibPQ as PQ

13−import Database.PostgreSQL.Simple.FromField

14−import Database.PostgreSQL.Simple.TypeInfo as TI

15−import Database.PostgreSQL.Simple.TypeInfo.Macro

16−import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI

17−

18−-------------------------------------------------------------------------------

19−-- Inspection tests

20−-------------------------------------------------------------------------------

21−

22−-- # doesn't work :(

23−#define TH_MKCOMPATS3(a,b,c) $(mkCompats [TI.a,TI.b,TI.c])

24−#define IN_MKCOMPATS3(a,b,c) (eq TI.a \/ eq TI.b \/ eq TI.c)

25−

26−#define TH_INLINETYPOID(n) eq $(inlineTypoid TI.n)

27−#define IN_INLINETYPOID(n) eq TI.n

28−

29−-- eta-expansion is required

30−lhs01, rhs01 :: PQ.Oid -> Bool

31−lhs01 = TH_MKCOMPATS3(name,text,char)

32−rhs01 = IN_MKCOMPATS3(nameOid,textOid,charOid)

33−

34−lhs02, rhs02 :: PQ.Oid -> Bool

35−lhs02 = TH_INLINETYPOID(name)

36−rhs02 = IN_INLINETYPOID(nameOid)

37−

38−eq :: PQ.Oid -> PQ.Oid -> Bool

39−eq = (==)

40−{-# INLINE eq #-}

41−

42−infixr 2 \/

43−(\/) :: (PQ.Oid -> Bool)

44− -> (PQ.Oid -> Bool)

45− -> (PQ.Oid -> Bool)

46−f \/ g = \x -> f x || g x

47−{-# INLINE (\/) #-}

48−

49−inspectionTests :: TestTree

50−inspectionTests = testGroup "inspection"

51− [ testCase "mkCompats" $

52− assertSuccess $(inspectTest $ 'lhs01 === 'rhs01)

53−

54− -- byteaOid isn't inlined?

55− , testCase "inlineTypoid" $

56−#if __GLASGOW_HASKELL__ >= 808

57− assertSuccess

58−#else

59− assertFailure'

60−#endif

61− $(inspectTest $ 'lhs02 ==- 'rhs02)

62− ]

63−

64−assertSuccess :: Result -> IO ()

65−assertSuccess (Success _) = return ()

66−assertSuccess (Failure err) = assertFailure err

67−

68−assertFailure' :: Result -> IO ()

69−assertFailure' (Success err) = assertFailure err

70−assertFailure' (Failure _) = return ()

71−

72−-------------------------------------------------------------------------------

73−-- Main

74−-------------------------------------------------------------------------------

75−

76−main :: IO ()

77−main = defaultMain $ testGroup "tests"

78− [ inspectionTests

79− ]

test/Interval.hsdeleted−176

@@ -1,176 +0,0 @@

1−{-# LANGUAGE QuasiQuotes #-}

2−

3−{-

4−

5−Testing strategies:

6−

7−fromString . toString == id ** Todo?

8−

9−toString . fromString == almost id ** Todo?

10−

11−postgresql -> haskell -> postgresql * Done

12−

13−haskell -> postgresql -> haskell ** Todo?

14−

15−But still, what we really want to establish is that the two values

16−correspond; for example, a conversion that consistently added hour

17−when printed to a string and subtracted an hour when parsed from string

18−would still pass these tests.

19−

20−

21−Right now, we are checking that 1400+ timestamps in the range of 1860 to

22−2060 round trip from postgresql to haskell and back in 5 different timezones.

23−In addition to UTC, the four timezones were selected so that 2 have a positive

24−offset, and 2 have a negative offset, and that 2 have an offset of a

25−whole number of hours, while the other two do not.

26−

27−It may be worth adding a few more timezones to ensure better test coverage.

28−

29−We are checking a handful of selected timestamps to ensure we hit

30−various corner-cases in the code, in addition to 1400 timestamps randomly

31−generated with granularity of seconds down to microseconds in powers of ten.

32−

33−-}

34−

35−module Interval (testInterval) where

36−

37−import Common

38−import Control.Monad(forM_, replicateM_)

39−import Data.Time.Compat

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

41−import Data.ByteString(ByteString)

42−import Database.PostgreSQL.Simple.SqlQQ

43−

44−data IntervalTestCase = IntervalTestCase

45− { label :: String

46− , inputMonths :: Integer

47− , inputSeconds :: NominalDiffTime

48− , asText :: String

49− }

50− deriving (Eq, Show)

51−

52−testInterval :: TestEnv -> Assertion

53−testInterval env@TestEnv{..} = do

54−

55− initializeTable env

56−

57− let milliseconds = 0.001

58− seconds = 1

59− minutes = 60 * seconds

60− hours = 60 * minutes

61− days = 24 * hours

62− weeks = 7 * days

63− months = 1

64− years = 12 * months

65−

66− mapM (checkRoundTrip env)

67− [ IntervalTestCase

68− { label = "zero"

69− , inputMonths = 0

70− , inputSeconds = 0

71− , asText = "PT0"

72− }

73− , IntervalTestCase

74− { label = "1 year"

75− , inputMonths = 1 * years

76− , inputSeconds = 0

77− , asText = "P1Y"

78− }

79− , IntervalTestCase

80− { label = "2 months"

81− , inputMonths = 2 * months

82− , inputSeconds = 0

83− , asText = "P2M"

84− }

85− , IntervalTestCase

86− { label = "3 weeks"

87− , inputMonths = 0

88− , inputSeconds = 3 * weeks

89− , asText = "P3W"

90− }

91− , IntervalTestCase

92− { label = "4 days"

93− , inputMonths = 0

94− , inputSeconds = 4 * days

95− , asText = "P4D"

96− }

97− , IntervalTestCase

98− { label = "5 hours"

99− , inputMonths = 0

100− , inputSeconds = 5 * hours

101− , asText = "PT5H"

102− }

103− , IntervalTestCase

104− { label = "6 minutes"

105− , inputMonths = 0

106− , inputSeconds = 6 * minutes

107− , asText = "PT6M"

108− }

109− , IntervalTestCase

110− { label = "7 seconds"

111− , inputMonths = 0

112− , inputSeconds = 7 * seconds

113− , asText = "PT7S"

114− }

115− , IntervalTestCase

116− { label = "8 milliseconds"

117− , inputMonths = 0

118− , inputSeconds = 8 * milliseconds

119− , asText = "PT0.008S"

120− }

121− , IntervalTestCase

122− { label = "combination of intervals (day-size or bigger)"

123− , inputMonths = 2 * years + 4 * months

124− , inputSeconds = 3 * weeks + 5 * days

125− , asText = "P2Y4M3W5D"

126− }

127− , IntervalTestCase

128− { label = "combination of intervals (smaller than day-size)"

129− , inputMonths = 0

130− , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

131− , asText = "PT18H56M23.563S"

132− }

133− , IntervalTestCase

134− { label = "full combination of intervals"

135− , inputMonths = 2 * years + 4 * months

136− , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

137− , asText = "P2Y4M3W5DT18H56M23.563S"

138− }

139− ]

140−

141− return ()

142−

143−initializeTable :: TestEnv -> IO ()

144−initializeTable TestEnv{..} = withTransaction conn $ do

145− execute_ conn

146− [sql| CREATE TEMPORARY TABLE testinterval

147− ( id serial, sample interval, PRIMARY KEY(id) ) |]

148−

149− return ()

150−

151−checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()

152−checkRoundTrip TestEnv{..} IntervalTestCase{..} = do

153−

154− let input = CalendarDiffTime

155− { ctMonths = inputMonths

156− , ctTime = inputSeconds

157− }

158−

159− [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|

160− INSERT INTO testinterval (sample)

161− VALUES (?)

162− RETURNING id, sample

163− |] (Only input)

164−

165− assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $

166− output == input

167−

168− [(Only isExpectedIso)] <- query conn [sql|

169− SELECT sample = (?)::interval

170− FROM testinterval

171− WHERE id = ?

172− |] (asText, returnedId)

173−

174− assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")

175− isExpectedIso

176−

test/Main.hs+32−179

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

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−

136import Common

14−import Database.PostgreSQL.Simple.Copy

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

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

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

179import Database.PostgreSQL.Simple.HStore

18−import Database.PostgreSQL.Simple.Newtypes

19−import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)

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

10+import Database.PostgreSQL.Simple.Copy

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

2212

2313import Control.Applicative

2414import Control.Exception as E

2515import Control.Monad

2616import Data.Char

27−import Data.Foldable (toList)

28−import Data.List (concat, sort)

17+import Data.List (sort)

2918import Data.IORef

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

31−import Data.String (fromString)

3219import Data.Typeable

3320import GHC.Generics (Generic)

3421

3522import Data.Aeson

3623import Data.ByteString (ByteString)

3724import qualified Data.ByteString as B

38−import qualified Data.ByteString.Char8 as BS8

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

4026import Data.CaseInsensitive (CI)

4127import qualified Data.CaseInsensitive as CI

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

4632import qualified Data.Vector as V

4733import System.FilePath

4834import System.Timeout(timeout)

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

50−import System.Environment (getEnvironment)

35+import Data.Time(getCurrentTime, diffUTCTime)

5136

5237import Test.Tasty

5338import Test.Tasty.Golden

5439import Notify

5540import Serializable

5641import Time

57−import Interval

58−import Exception (testExceptions)

5942

6043tests :: TestEnv -> TestTree

6144tests env = testGroup "tests"

6245 $ map ($ env)

6346 [ testBytea

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

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

8261 , testCopyFailures

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

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

8967 ]

9068

9169testBytea :: TestEnv -> TestTree

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

139117 xs <- readIORef ref

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

141119 xs <- readIORef ref

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

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

143121

144122 -- Make sure fold propagates our exception.

145123 ref <- newIORef []

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

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

257235 [js] @?= js'

258236

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−

343237testSavepoint :: TestEnv -> Assertion

344238testSavepoint TestEnv{..} = do

345239 True <- expectError ST.isNoActiveTransactionError $

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

447341 -- so that we can issue more queries:

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

449343 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

458344 where

459345 copyRows = ["1,foo\n"

460346 ,"2,bar\n"]

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

474360

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

476362goldenTest testName =

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

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

478364 where

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

480366 fileName = map normalize testName

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

482368 | otherwise = c

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

484369

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

486371testCopyUniqueConstraintError :: TestEnv -> TestTree

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

593478isSyntaxError :: SqlError -> Bool

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

595480

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

604481------------------------------------------------------------------------

605482

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

607484--

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

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

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

487+testConnect :: IO Connection

488+testConnect = connectPostgreSQL ""

616489

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

491+withTestEnv cb =

492+ withConn $ \conn ->

617493 cb TestEnv

618494 { conn = conn

619495 , withConn = withConn

620496 }

621497 where

622− withConn = bracket (connectPostgreSQL connstr) close

498+ withConn = bracket testConnect close

623499

624500main :: IO ()

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

501+main = withTestEnv $ defaultMain . tests

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

39+import Data.Time

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 type integer: "z"

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

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

44)

tools/GenTypeInfo.hs+25−39

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

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

2724------------------------------------------------------------------------------

2825

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

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

4138import Database.PostgreSQL.Simple.Ok

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

4340import Database.PostgreSQL.Simple.SqlQQ

44−import qualified Data.ByteString.Char8 as B8

41+import qualified Data.ByteString.Char8 as B

4542import Data.ByteString(ByteString)

4643import qualified Data.ByteString.Lazy as L

47−import qualified Data.ByteString.Builder as Blaze

44+import qualified Blaze.ByteString.Builder as Blaze

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

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

4847import Data.String

4948import Data.List ( sort, intersperse )

5049import qualified Data.Map as Map

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

7069instance FromRow TypeInfo where

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

7271

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

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

7473

7574type OidMap = Map.Map Oid TypeInfo

7675

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

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

7877

7978type TypeNames = [TypeName]

8079

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

198197_int8range

199198|]

200199

200+instance IsString Blaze.Builder where

201+ fromString = Blaze.fromByteString . fromString

202+

201203connectionString = "dbname=postgres"

202204

203205withPostgreSQL = bracket (connectPostgreSQL connectionString) close

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

235237

236238main = do

237239 (oidmap, namemap) <- getTypeInfos typeNames

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

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

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

240242

241243

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

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

245247renderOid byName name

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

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

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

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

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

250252

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

262264 typelem_hs_name =

263265 case lookup (typname typelem_info) typeNames of

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

265− ++ B8.unpack( typname typelem_info)

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

267+ ++ B.unpack( typname typelem_info)

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

267269 ++ ")")

268270 Just x -> x

269271 in concat

270272 [ "\n"

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

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

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

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

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

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

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

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

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

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

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

284281 ]

285282 | typcategory info == 'R' =

286283 let (Just rngsubtype_oid) = rngsubtype info

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

288285 rngsubtype_hs_name =

289286 case lookup (typname rngsubtype_info) typeNames of

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

291− ++ B8.unpack (typname rngsubtype_info)

288+ ++ B.unpack (typname rngsubtype_info)

292289 ++ " (rngsubtype of "

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

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

294291 Just x -> x

295292 in concat

296293 [ "\n"

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

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

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

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

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

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

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

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

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

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

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

310302 ]

311303 | otherwise =

312304 concat

313305 [ "\n"

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

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

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

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

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

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

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

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

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

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

326313 ]

327314

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

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

331318getNames :: NameMap -> TypeNames -> TypeNames

332319getNames _ x = x

333320

334−bs = Blaze.byteString

321+bs = Blaze.fromByteString

335322

336323pg = fst

337324

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

360347 ( TypeInfo(..)

361348 , staticTypeInfo

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

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

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

365351 ) where

366352