master..55ea269 · typeable/postgresql-simple

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

.travis.ymlnew file+177

@@ -0,0 +1,177 @@

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

2+#

3+# haskell-ci '--config' 'cabal.haskell-ci' '--output' '.travis.yml' 'postgresql-simple.cabal'

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

12+#

13+version: ~> 1.0

14+language: c

15+os: linux

16+dist: xenial

17+git:

18+ # whether to recursively clone submodules

19+ submodules: false

20+branches:

21+ only:

22+ - master

23+services:

24+ - postgresql

25+addons:

26+ postgresql: "10"

27+cache:

28+ directories:

29+ - $HOME/.cabal/packages

30+ - $HOME/.cabal/store

31+ - $HOME/.hlint

32+before_cache:

33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log

34+ # remove files that are regenerated by 'cabal update'

35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*

36+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json

37+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache

38+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar

39+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

40+ - rm -rfv $CABALHOME/packages/head.hackage

41+jobs:

42+ include:

43+ - compiler: ghc-8.10.2

44+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.2","cabal-install-3.4"]}}

45+ env: DATABASE_CONNSTRING=travis

46+ os: linux

47+ - compiler: ghc-8.8.4

48+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.4","cabal-install-3.4"]}}

49+ env: DATABASE_CONNSTRING=travis

50+ os: linux

51+ - compiler: ghc-8.6.5

52+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.4"]}}

53+ env: DATABASE_CONNSTRING=travis

54+ os: linux

55+ - compiler: ghc-8.4.4

56+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.4"]}}

57+ env: DATABASE_CONNSTRING=travis

58+ os: linux

59+ - compiler: ghc-8.2.2

60+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.4"]}}

61+ env: DATABASE_CONNSTRING=travis

62+ os: linux

63+ - compiler: ghc-8.0.2

64+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.4"]}}

65+ env: DATABASE_CONNSTRING=travis

66+ os: linux

67+ - compiler: ghc-7.10.3

68+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.4"]}}

69+ env: DATABASE_CONNSTRING=travis

70+ os: linux

71+ - compiler: ghc-7.8.4

72+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.4"]}}

73+ env: DATABASE_CONNSTRING=travis

74+ os: linux

75+ - compiler: ghc-7.6.3

76+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.6.3","cabal-install-3.4"]}}

77+ env: DATABASE_CONNSTRING=travis

78+ os: linux

79+before_install:

80+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')

81+ - WITHCOMPILER="-w $HC"

82+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')

83+ - HCPKG="$HC-pkg"

84+ - unset CC

85+ - CABAL=/opt/ghc/bin/cabal

86+ - CABALHOME=$HOME/.cabal

87+ - export PATH="$CABALHOME/bin:$PATH"

88+ - TOP=$(pwd)

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

90+ - echo $HCNUMVER

91+ - CABAL="$CABAL -vnormal+nowrap"

92+ - set -o pipefail

93+ - TEST=--enable-tests

94+ - BENCH=--enable-benchmarks

95+ - HEADHACKAGE=false

96+ - rm -f $CABALHOME/config

97+ - |

98+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config

99+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config

100+ echo "write-ghc-environment-files: always" >> $CABALHOME/config

101+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config

102+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config

103+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config

104+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config

105+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config

106+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config

107+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config

108+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config

109+ echo "install-dirs user" >> $CABALHOME/config

110+ echo " prefix: $CABALHOME" >> $CABALHOME/config

111+ echo "repository hackage.haskell.org" >> $CABALHOME/config

112+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config

113+install:

114+ - ${CABAL} --version

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

116+ - |

117+ echo "program-default-options" >> $CABALHOME/config

118+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config

119+ - cat $CABALHOME/config

120+ - rm -fv cabal.project cabal.project.local cabal.project.freeze

121+ - travis_retry ${CABAL} v2-update -v

122+ # Generate cabal.project

123+ - rm -rf cabal.project cabal.project.local cabal.project.freeze

124+ - touch cabal.project

125+ - |

126+ echo "packages: ." >> cabal.project

127+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi

128+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"

129+ - |

130+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(postgresql-simple)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

131+ - cat cabal.project || true

132+ - cat cabal.project.local || true

133+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi

134+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}

135+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"

136+ - rm cabal.project.freeze

137+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all

138+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all

139+script:

140+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

141+ # Packaging...

142+ - ${CABAL} v2-sdist all

143+ # Unpacking...

144+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

145+ - cd ${DISTDIR} || false

146+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;

147+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;

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

149+ # Generate cabal.project

150+ - rm -rf cabal.project cabal.project.local cabal.project.freeze

151+ - touch cabal.project

152+ - |

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

154+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi

155+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"

156+ - |

157+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(postgresql-simple)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

158+ - cat cabal.project || true

159+ - cat cabal.project.local || true

160+ # Building...

161+ # this builds all libraries and executables (without tests/benchmarks)

162+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all

163+ # Building with tests and benchmarks...

164+ # build & run tests, build benchmarks

165+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all

166+ # Testing...

167+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all

168+ # cabal check...

169+ - (cd ${PKGDIR_postgresql_simple} && ${CABAL} -vnormal check)

170+ # haddock...

171+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all

172+ # Building without installed constraints for packages in global-db...

173+ - rm -f cabal.project.local

174+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all

175+

176+# REGENDATA ("0.11.20200918",["--config","cabal.haskell-ci","--output",".travis.yml","postgresql-simple.cabal"])

177+# EOF

CHANGES.md+4−54

@@ -1,53 +1,3 @@

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

2−

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

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

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

6− * Drop support for GHC prior 8.6

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

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

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

10−

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

12−

13− * Support `aeson-2.2.0.0`

14−

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

16−

17− * Add `withConnect`

18−

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

20−

21− * Add foldCopyData helper function

22− Thanks to Sebastián Estrella for the implementation

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

24− * Implement support for postgresql 'interval' type

25− Thanks to Andre Marques Lee for the implementation

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

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

28−

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

30−

31− * Add `fromFieldJSONByteString`

32− Thanks to tomjaguarpaw for the implementation

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

34− * Add `attoFieldParser`

35− Thanks to Victor Nawothnig for the implementation

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

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

38− Thanks to Cary Robbins for the implementation

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

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

41− for all exception types.

42− Thanks to Elliot Cameron for the implementation

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

44− * Fix spurious aborts when retrying transactions

45− Thanks to Elliot Cameron for the implementation

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

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

48− with `Aeson` newtype.

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

50−

511### Version 0.6.2 (2019-04-26)

522

533 * Define `MonadFail Ok`.

@@ -271,7 +221,7 @@

271221 support UTF8 except for Mule Internal Code, the Multilingual

272222 Extensions for Emacs. An exception should be raised upon

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

274− accommodate this requirement.

224+ accomodate this requirement.

275225

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

277227

@@ -409,7 +359,7 @@

409359

410360 * Changed the Identifier and QualifiedIdentifier to use Text in

411361 order to avoid encoding errors. Technically this requires a

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

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

413363

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

415365 and tweaked error messages.

@@ -569,7 +519,7 @@

569519

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

571521 convenient and efficient access to the pg_type metatable. This

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

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

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

574524 work on this feature.

575525

@@ -661,7 +611,7 @@

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

662612

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

664− that accommodate PostgreSQL's infinities.

614+ that accomodate PostgreSQL's infinities.

665615

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

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

CONTRIBUTING.md+1−1

@@ -4,7 +4,7 @@ Patches welcome!

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

55 - 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**:

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

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

88

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

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

README.md+3

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

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

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

23

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

appveyor.ymlnew file+80

@@ -0,0 +1,80 @@

1+clone_folder: "c:\\WORK"

2+

3+branches:

4+ only:

5+ - master

6+

7+services:

8+ - postgresql96

9+

10+environment:

11+ global:

12+ CABOPTS: "--store-dir=C:\\SR --http-transport=plain-http"

13+ PGUSER: postgres

14+ PGPASSWORD: Password12!

15+ PGPORT: "5432"

16+ DATABASE_CONNSTRING: appveyor

17+ matrix:

18+ # 64 bit builds

19+ - GHCVER: "8.8.1"

20+ CHOCOPTS:

21+ - GHCVER: "8.6.5"

22+ CHOCOPTS:

23+ - GHCVER: "8.4.4"

24+ CHOCOPTS:

25+ - GHCVER: "8.2.2"

26+ CHOCOPTS:

27+ - GHCVER: "8.0.2"

28+ CHOCOPTS:

29+ - GHCVER: "7.10.3.2"

30+ CHOCOPTS:

31+

32+ # Fails to link

33+ #

34+ # - GHCVER: "7.8.4.1"

35+ # CHOCOPTS:

36+

37+ # 32 bit builds

38+

39+ # Linker errors...

40+

41+ # - GHCVER: "8.6.5"

42+ # CHOCOPTS: --forcex86

43+ # - GHCVER: "8.4.4"

44+ # CHOCOPTS: --forcex86

45+ # - GHCVER: "8.2.2"

46+ # CHOCOPTS: --forcex86

47+

48+ # older segfault?

49+

50+cache:

51+- "C:\\SR"

52+

53+install:

54+ - "choco install -y ghc --version %GHCVER% %CHOCOPTS%"

55+ - "choco install -y cabal %CHOCOPTS%"

56+ - "refreshenv"

57+ - "set PATH=C:\\ghc\\ghc-%GHCVER%:C:\\msys64\\mingw64\\bin;C:\\msys64\\usr\\bin;%PATH%"

58+ - "cabal --version"

59+ - "ghc --version"

60+

61+ - set PATH=C:\Progra~1\PostgreSQL\9.6\bin\;%PATH%

62+

63+build: off

64+

65+test_script:

66+ - "cabal %CABOPTS% update -v"

67+ - createdb TestDb

68+ - IF EXIST configure.ac bash -c "autoreconf -i"

69+ - "move cabal.project.local.win cabal.project.local"

70+

71+ - "cabal %CABOPTS% v2-build -j1 libs test"

72+ # - "cabal %CABOPTS% v2-test -j1 all"

73+ - "cabal %CABOPTS% v2-run test"

74+ # - "cabal %CABOPTS% v2-run inspection" # only GHC-8.0 (or GHC-8.2+)

75+

76+ # Build from sdist

77+ - "rmdir /Q /S dist-newstyle"

78+ - "cabal v2-sdist"

79+ - "sh -c 'echo packages: dist-newstyle/sdist/*.tar.gz > cabal.project'"

80+ - "cabal v2-build -j1 postgresql-simple" # TODO: unfortunately the package name have to be here

cabal.haskell-ci+10

@@ -3,3 +3,13 @@ postgresql: True

33

44-- services aren't supported on Travis on macOS

55-- osx: 8.4.4

6+

7+env: 7.6.3:DATABASE_CONNSTRING=travis

8+env: 7.8.4:DATABASE_CONNSTRING=travis

9+env: 7.10.3:DATABASE_CONNSTRING=travis

10+env: 8.0.2:DATABASE_CONNSTRING=travis

11+env: 8.2.2:DATABASE_CONNSTRING=travis

12+env: 8.4.4:DATABASE_CONNSTRING=travis

13+env: 8.6.5:DATABASE_CONNSTRING=travis

14+env: 8.8.4:DATABASE_CONNSTRING=travis

15+env: 8.10.2:DATABASE_CONNSTRING=travis

cabal.project−2

@@ -1,4 +1,2 @@

11packages: .

22tests: true

3−

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

postgresql-simple.cabal+50−32

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

11cabal-version: 1.12

22name: postgresql-simple

3−version: 0.7.0.0

4−x-revision: 1

3+version: 0.6.2

4+x-revision: 4

55synopsis: Mid-Level PostgreSQL client library

66description:

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

@@ -13,7 +13,7 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>

1313copyright:

1717

1818category: Database

1919build-type: Simple

@@ -24,14 +24,15 @@ extra-source-files:

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

2525

2626tested-with:

27− GHC ==8.6.5

27+ GHC ==7.6.3

28+ || ==7.8.4

29+ || ==7.10.3

30+ || ==8.0.2

31+ || ==8.2.2

32+ || ==8.4.4

33+ || ==8.6.5

2834 || ==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+ || ==8.10.2

3536

3637library

3738 default-language: Haskell2010

@@ -48,7 +49,6 @@ library

4849 Database.PostgreSQL.Simple.HStore.Internal

4950 Database.PostgreSQL.Simple.Internal

5051 Database.PostgreSQL.Simple.LargeObjects

51− Database.PostgreSQL.Simple.Newtypes

5252 Database.PostgreSQL.Simple.Notification

5353 Database.PostgreSQL.Simple.Ok

5454 Database.PostgreSQL.Simple.Range

@@ -77,25 +77,34 @@ library

7777

7878 -- GHC bundled libs

7979 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

80+ base >=4.6.0.0 && <4.15

81+ , bytestring >=0.10.0.0 && <0.12

82+ , containers >=0.5.0.0 && <0.7

83+ , template-haskell >=2.8.0.0 && <2.17

84+ , text >=1.2.3.0 && <1.3

85+ , time >=1.4.0.1 && <1.12

86+ , transformers >=0.3.0.0 && <0.6

8787

8888 -- Other dependencies

8989 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

90+ aeson >=1.4.1.0 && <1.6

91+ , attoparsec >=0.13.2.2 && <0.14

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

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

94+ , hashable >=1.2.7.0 && <1.4

95+ , Only >=0.1 && <0.1.1

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

97+ , scientific >=0.3.6.2 && <0.4

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

99+ , vector >=0.12.0.1 && <0.13

100+

101+ if !impl(ghc >=8.0)

102+ build-depends:

103+ fail >=4.9.0.0 && <4.10

104+ , semigroups >=0.18.5 && <0.20

105+

106+ if !impl(ghc >=7.6)

107+ build-depends: ghc-prim

99108

100109 default-extensions:

101110 BangPatterns

@@ -108,16 +117,24 @@ library

108117

109118source-repository head

110119 type: git

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

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

121+

122+source-repository this

123+ type: git

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

125+ tag: v0.6

112126

113127test-suite inspection

128+ if !impl(ghc >=8.0)

129+ buildable: False

130+

114131 default-language: Haskell2010

115132 type: exitcode-stdio-1.0

116133 hs-source-dirs: test

117134 main-is: Inspection.hs

118135 build-depends:

119136 base

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

137+ , inspection-testing >=0.4.1.1 && <0.5

121138 , postgresql-libpq

122139 , postgresql-simple

123140 , tasty

@@ -130,8 +147,6 @@ test-suite test

130147 main-is: Main.hs

131148 other-modules:

132149 Common

133− Exception

134− Interval

135150 Notify

136151 Serializable

137152 Time

@@ -161,9 +176,12 @@ test-suite test

161176 , tasty-golden

162177 , tasty-hunit

163178 , text

164− , time-compat

179+ , time

165180 , vector

166181

182+ if !impl(ghc >=7.6)

183+ build-depends: ghc-prim

184+

167185benchmark select

168186 default-language: Haskell2010

169187 type: exitcode-stdio-1.0

src/Database/PostgreSQL/Simple.hs+1−3

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

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

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

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

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

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

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

906904--

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

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

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+5−26

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

3232 ( copy

3333 , copy_

3434 , CopyOutResult(..)

35− , foldCopyData

3635 , getCopyData

3736 , putCopyData

3837 , putCopyEnd

@@ -55,7 +54,7 @@ import Database.PostgreSQL.Simple.Internal hiding (result, row)

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/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+21−55

@@ -2,7 +2,6 @@

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

44{-# LANGUAGE RecordWildCards #-}

5−{-# LANGUAGE PolyKinds #-}

65

76{- |

87Module: Database.PostgreSQL.Simple.FromField

@@ -107,7 +106,6 @@ module Database.PostgreSQL.Simple.FromField

107106 , PQ.Oid(..)

108107 , PQ.Format(..)

109108 , pgArrayFieldParser

110− , attoFieldParser

111109

112110 , optionalField

113111 , fromJSONField

@@ -116,18 +114,19 @@ module Database.PostgreSQL.Simple.FromField

116114

117115#include "MachDeps.h"

118116

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

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

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

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

119+import Control.Exception (Exception)

122120import qualified Data.Aeson as JSON

121+import qualified Data.Aeson.Internal as JSON

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

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

124124import Data.ByteString (ByteString)

125125import qualified Data.ByteString.Char8 as B

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

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

128127import Data.IORef (IORef, newIORef)

129128import Data.Ratio (Ratio)

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

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

131130import Data.Typeable (Typeable, typeOf)

132131import Data.Vector (Vector)

133132import Data.Vector.Mutable (IOVector)

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

154153import Data.Scientific (Scientific)

155154import GHC.Real (infinity, notANumber)

156155

157−import qualified Data.Aeson.Types as JSON

158−

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

160157-- value fails.

161158data ResultError = Incompatible { errSQLType :: String

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

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

183180 deriving (Eq, Show, Typeable)

184181

185−instance Exception ResultError where

186− toException = postgresqlExceptionToException

187− fromException = postgresqlExceptionFromException

182+instance Exception ResultError

188183

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

190185left = conversionError

@@ -273,12 +268,6 @@ instance FromField () where

273268 | typeOid f /= TI.voidOid = returnError Incompatible f ""

274269 | otherwise = pure ()

275270

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−

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

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

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

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

325314

326315-- | int2

327316instance FromField Int16 where

328− fromField = attoFieldParser ok16 $ signed decimal

317+ fromField = atto ok16 $ signed decimal

329318

330319-- | int2, int4

331320instance FromField Int32 where

332− fromField = attoFieldParser ok32 $ signed decimal

321+ fromField = atto ok32 $ signed decimal

333322

334323#if WORD_SIZE_IN_BITS < 64

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

@@ -339,36 +328,36 @@ instance FromField Int32 where

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

340329#endif

341330instance FromField Int where

342− fromField = attoFieldParser okInt $ signed decimal

331+ fromField = atto okInt $ signed decimal

343332

344333-- | int2, int4, int8

345334instance FromField Int64 where

346− fromField = attoFieldParser ok64 $ signed decimal

335+ fromField = atto ok64 $ signed decimal

347336

348337-- | int2, int4, int8

349338instance FromField Integer where

350− fromField = attoFieldParser ok64 $ signed decimal

339+ fromField = atto ok64 $ signed decimal

351340

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

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

354343instance FromField Float where

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

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

356345 where ok = eq TI.float4Oid \/ eq TI.int2Oid

357346

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

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

360349instance FromField Double where

361− fromField = attoFieldParser ok pg_double

350+ fromField = atto ok pg_double

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

363352

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

365354instance FromField (Ratio Integer) where

366− fromField = attoFieldParser ok pg_rational

355+ fromField = atto ok pg_rational

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

368357

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

370359instance FromField Scientific where

371− fromField = attoFieldParser ok rational

360+ fromField = atto ok rational

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

373362

374363unBinary :: Binary t -> t

@@ -396,7 +385,7 @@ instance FromField SB.ByteString where

396385

397386-- | oid

398387instance FromField PQ.Oid where

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

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

400389

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

402391instance FromField LB.ByteString where

@@ -489,15 +478,6 @@ instance FromField LocalTimestamp where

489478instance FromField Date where

490479 fromField = ff TI.dateOid "Date" parseDate

491480

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

493−--

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

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

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

497−--

498−instance FromField CalendarDiffTime where

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

500−

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

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

503483ff compatOid hsType parseBS f mstr =

@@ -576,13 +556,11 @@ instance FromField UUID where

576556-- | json, jsonb

577557instance FromField JSON.Value where

578558 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs

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

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

580560 Left err -> returnError ConversionFailed f err

581561 Right val -> pure val

582562

583563-- | Return the JSON ByteString directly

584−--

585−-- @since 0.6.3

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

587565fromFieldJSONByteString f mbs =

588566 if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid

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

684662 (show (typeOf (undefined :: a)))

685663 msg

686664

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

665+atto :: forall a. (Typeable a)

666+ => Compat -> Parser a -> Field -> Maybe ByteString

667+ -> Conversion a

668+atto types p0 f dat = doFromField f types (go p0) dat

703669 where

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

705671 go p s =

src/Database/PostgreSQL/Simple/HStore/Implementation.hs+6

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

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

src/Database/PostgreSQL/Simple/Internal.hs+7−37

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

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

22{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

33{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE ExistentialQuantification #-}

5−{-# LANGUAGE InstanceSigs #-}

64

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

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

src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+4

@@ -76,8 +76,12 @@ finishQueryWith' q result k = do

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

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

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

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

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

@@ -72,6 +72,10 @@ instance MonadPlus Ok where

7272 mplus = (<|>)

7373

7474instance Monad Ok where

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

76+ return = pure

77+#endif

78+

7579 Errors es >>= _ = Errors es

7680 Ok a >>= f = f a

7781

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

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

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

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

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3−{-# LANGUAGE PolyKinds #-}

43

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

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/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/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+8−85

@@ -3,19 +3,10 @@

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

147import Database.PostgreSQL.Simple.Copy

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

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

179import Database.PostgreSQL.Simple.HStore

18−import Database.PostgreSQL.Simple.Newtypes

1910import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)

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

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

@@ -24,7 +15,6 @@ import Control.Applicative

2415import Control.Exception as E

2516import Control.Monad

2617import Data.Char

27−import Data.Foldable (toList)

2818import Data.List (concat, sort)

2919import Data.IORef

3020import Data.Monoid ((<>))

@@ -46,7 +36,7 @@ import qualified Data.Text.Encoding as T

4636import qualified Data.Vector as V

4737import System.FilePath

4838import System.Timeout(timeout)

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

39+import Data.Time(getCurrentTime, diffUTCTime)

5040import System.Environment (getEnvironment)

5141

5242import Test.Tasty

@@ -54,8 +44,6 @@ import Test.Tasty.Golden

5444import Notify

5545import Serializable

5646import Time

57−import Interval

58−import Exception (testExceptions)

5947

6048tests :: TestEnv -> TestTree

6149tests env = testGroup "tests"

@@ -66,14 +54,11 @@ tests env = testGroup "tests"

6654 , testCase "Notify" . testNotify

6755 , testCase "Serializable" . testSerializable

6856 , testCase "Time" . testTime

69− , testCase "Interval" . testInterval

7057 , testCase "Array" . testArray

7158 , testCase "Array of nullables" . testNullableArray

7259 , testCase "HStore" . testHStore

7360 , testCase "citext" . testCIText

7461 , testCase "JSON" . testJSON

75− , testCase "Aeson newtype" . testAeson

76− , testCase "DerivingVia" . testDerivingVia

7762 , testCase "Question mark escape" . testQM

7863 , testCase "Savepoint" . testSavepoint

7964 , testCase "Unicode" . testUnicode

@@ -85,7 +70,6 @@ tests env = testGroup "tests"

8570 , testCase "2-ary generic" . testGeneric2

8671 , testCase "3-ary generic" . testGeneric3

8772 , testCase "Timeout" . testTimeout

88− , testCase "Exceptions" . testExceptions

8973 ]

9074

9175testBytea :: TestEnv -> TestTree

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

139123 xs <- readIORef ref

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

141125 xs <- readIORef ref

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

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

143127

144128 -- Make sure fold propagates our exception.

145129 ref <- newIORef []

@@ -256,40 +240,6 @@ testJSON TestEnv{..} = do

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

257241 [js] @?= js'

258242

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−

293243testQM :: TestEnv -> Assertion

294244testQM TestEnv{..} = do

295245 -- Just test on a single string

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

447397 -- so that we can issue more queries:

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

449399 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

458400 where

459401 copyRows = ["1,foo\n"

460402 ,"2,bar\n"]

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

474416

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

476418goldenTest testName =

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

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

478420 where

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

480422 fileName = map normalize testName

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

482424 | otherwise = c

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

484425

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

486427testCopyUniqueConstraintError :: TestEnv -> TestTree

@@ -609,11 +550,7 @@ isFormatError i FormatError{..}

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

610551withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

611552withTestEnv 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'"

616−

553+ withConn $ \conn ->

617554 cb TestEnv

618555 { conn = conn

619556 , withConn = withConn

@@ -622,27 +559,13 @@ withTestEnv connstr cb =

622559 withConn = bracket (connectPostgreSQL connstr) close

623560

624561main :: IO ()

625−main = withConnstring $ \connstring -> do

626− withTestEnv connstring (defaultMain . tests)

627−

628−withConnstring :: (BS8.ByteString -> IO ()) -> IO ()

629−withConnstring kont = do

562+main = do

630563 env <- getEnvironment

631564 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

565+ Nothing -> putStrLn "Set DATABASE_CONNSTRING environment variable"

566+ Just s -> withTestEnv (BS8.pack (special s)) (defaultMain . tests)

567+ where

637568 -- https://www.appveyor.com/docs/services-databases/

638569 special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"

639570 special "travis" = ""

640571 special s = s

641−

642− gha = unwords

643− [ "dbname='postgres'"

644− , "user='postgres'"

645− , "password='postgres'"

646− , "host='postgres'"

647− , "port=5432"

648− ]

test/Time.hs+1−1

@@ -36,7 +36,7 @@ module Time (testTime) where

3636

3737import Common

3838import Control.Monad(forM_, replicateM_)

39−import Data.Time.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)