61837eb...master · typeable/postgresql-simple

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

since splitsnapshots

unifiedsplit

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

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

2+#

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

4+#

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

6+#

7+# haskell-ci regenerate

8+#

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

10+#

11+# version: 0.17.20231110

12+#

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

14+#

15+name: Haskell-CI

16+on:

17+ push:

18+ branches:

19+ - master

20+ pull_request:

21+ branches:

22+ - master

23+jobs:

24+ linux:

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

26+ runs-on: ubuntu-20.04

27+ timeout-minutes:

28+ 60

29+ container:

30+ image: buildpack-deps:bionic

31+ services:

32+ postgres:

33+ image: postgres:14

34+ env:

35+ POSTGRES_PASSWORD: postgres

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

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

38+ strategy:

39+ matrix:

40+ include:

41+ - compiler: ghc-9.8.1

42+ compilerKind: ghc

43+ compilerVersion: 9.8.1

44+ setup-method: ghcup

45+ allow-failure: false

46+ - compiler: ghc-9.6.3

47+ compilerKind: ghc

48+ compilerVersion: 9.6.3

49+ setup-method: ghcup

50+ allow-failure: false

51+ - compiler: ghc-9.4.8

52+ compilerKind: ghc

53+ compilerVersion: 9.4.8

54+ setup-method: ghcup

55+ allow-failure: false

56+ - compiler: ghc-9.2.8

57+ compilerKind: ghc

58+ compilerVersion: 9.2.8

59+ setup-method: ghcup

60+ allow-failure: false

61+ - compiler: ghc-9.0.2

62+ compilerKind: ghc

63+ compilerVersion: 9.0.2

64+ setup-method: ghcup

65+ allow-failure: false

66+ - compiler: ghc-8.10.7

67+ compilerKind: ghc

68+ compilerVersion: 8.10.7

69+ setup-method: ghcup

70+ allow-failure: false

71+ - compiler: ghc-8.8.4

72+ compilerKind: ghc

73+ compilerVersion: 8.8.4

74+ setup-method: hvr-ppa

75+ allow-failure: false

76+ - compiler: ghc-8.6.5

77+ compilerKind: ghc

78+ compilerVersion: 8.6.5

79+ setup-method: hvr-ppa

80+ allow-failure: false

81+ fail-fast: false

82+ steps:

83+ - name: apt

84+ run: |

85+ apt-get update

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

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

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

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

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

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

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

93+ else

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

95+ apt-get update

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

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

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

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

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

101+ fi

102+ env:

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

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

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

106+ - name: Set PATH and environment variables

107+ run: |

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

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

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

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

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

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

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

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

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

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

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

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

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

121+ else

122+ HC=$HCDIR/bin/$HCKIND

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

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

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

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

127+ fi

128+

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

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

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

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

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

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

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

136+ env:

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

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

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

140+ - name: env

141+ run: |

142+ env

143+ - name: write cabal config

144+ run: |

145+ mkdir -p $CABAL_DIR

146+ cat >> $CABAL_CONFIG <<EOF

147+ remote-build-reporting: anonymous

148+ write-ghc-environment-files: never

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

150+ logs-dir: $CABAL_DIR/logs

151+ world-file: $CABAL_DIR/world

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

153+ symlink-bindir: $CABAL_DIR/bin

154+ installdir: $CABAL_DIR/bin

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

156+ store-dir: $CABAL_DIR/store

157+ install-dirs user

158+ prefix: $CABAL_DIR

159+ repository hackage.haskell.org

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

161+ EOF

162+ cat >> $CABAL_CONFIG <<EOF

163+ program-default-options

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

165+ EOF

166+ cat $CABAL_CONFIG

167+ - name: versions

168+ run: |

169+ $HC --version || true

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

171+ $CABAL --version || true

172+ - name: update cabal index

173+ run: |

174+ $CABAL v2-update -v

175+ - name: install cabal-plan

176+ run: |

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

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

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

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

181+ rm -f cabal-plan.xz

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

183+ cabal-plan --version

184+ - name: checkout

185+ uses: actions/checkout@v3

186+ with:

187+ path: source

188+ - name: initial cabal.project for sdist

189+ run: |

190+ touch cabal.project

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

192+ cat cabal.project

193+ - name: sdist

194+ run: |

195+ mkdir -p sdist

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

197+ - name: unpack

198+ run: |

199+ mkdir -p unpacked

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

201+ - name: generate cabal.project

202+ run: |

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

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

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

206+ touch cabal.project

207+ touch cabal.project.local

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

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

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

211+ cat >> cabal.project <<EOF

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

213+ EOF

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

215+ cat cabal.project

216+ cat cabal.project.local

217+ - name: dump install plan

218+ run: |

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

220+ cabal-plan

221+ - name: restore cache

222+ uses: actions/cache/restore@v3

223+ with:

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

225+ path: ~/.cabal/store

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

227+ - name: install dependencies

228+ run: |

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

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

231+ - name: build w/o tests

232+ run: |

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

234+ - name: build

235+ run: |

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

237+ - name: tests

238+ run: |

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

240+ - name: cabal check

241+ run: |

242+ cd ${PKGDIR_postgresql_simple} || false

243+ ${CABAL} -vnormal check

244+ - name: haddock

245+ run: |

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

247+ - name: unconstrained build

248+ run: |

249+ rm -f cabal.project.local

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

251+ - name: save cache

252+ uses: actions/cache/save@v3

253+ if: always()

254+ with:

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

256+ path: ~/.cabal/store

.github/workflows/simple.ymlnew file+58

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

1+name: Simple

2+on:

3+ push:

4+ branches:

5+ - master

6+ pull_request:

7+ branches:

8+ - master

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.ymldeleted−177

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

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+42−4

@@ -1,3 +1,31 @@

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+

1### Version 0.6.3 (2020-11-15)

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

2

30

3 * Add `fromFieldJSONByteString`

31 * Add `fromFieldJSONByteString`

@@ -9,6 +37,16 @@

9 * Add `Identity` and `Const` instance

37 * Add `Identity` and `Const` instance

10 Thanks to Cary Robbins for the implementation

38 Thanks to Cary Robbins for the implementation

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

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

12

50

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

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

14

52

@@ -233,7 +271,7 @@

233 support UTF8 except for Mule Internal Code, the Multilingual

271 support UTF8 except for Mule Internal Code, the Multilingual

234 Extensions for Emacs. An exception should be raised upon

272 Extensions for Emacs. An exception should be raised upon

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

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

236− accomodate this requirement.

274+ accommodate this requirement.

237

275

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

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

239

277

@@ -371,7 +409,7 @@

371

409

372 * Changed the Identifier and QualifiedIdentifier to use Text in

410 * Changed the Identifier and QualifiedIdentifier to use Text in

373 order to avoid encoding errors. Technically this requires a

411 order to avoid encoding errors. Technically this requires a

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

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

375

413

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

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

377 and tweaked error messages.

415 and tweaked error messages.

@@ -531,7 +569,7 @@

531

569

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

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

533 convenient and efficient access to the pg_type metatable. This

571 convenient and efficient access to the pg_type metatable. This

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

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

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

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

536 work on this feature.

574 work on this feature.

537

575

@@ -623,7 +661,7 @@

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

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

624

662

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

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

626− that accomodate PostgreSQL's infinities.

664+ that accommodate PostgreSQL's infinities.

627

665

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

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

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

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

CONTRIBUTING.md+1−1

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

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 `.travis.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci))

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`

README.md−3

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

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

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

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

3

2

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

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

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

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

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

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

appveyor.ymldeleted−80

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

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,13 +3,3 @@ postgresql: True

3

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

5-- 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,2 +1,4 @@

1packages: .

2tests: true

3+

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

postgresql-simple.cabal+32−49

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

1cabal-version: 1.12

2name: postgresql-simple

3−version: 0.6.3

3+version: 0.7.0.0

4+x-revision: 1

4synopsis: Mid-Level PostgreSQL client library

5synopsis: Mid-Level PostgreSQL client library

5description:

6description:

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

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

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

12copyright:

13copyright:

16

17

17category: Database

18category: Database

18build-type: Simple

19build-type: Simple

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

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

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

24

25

25tested-with:

26tested-with:

26− GHC ==7.6.3

27− || ==7.8.4

28− || ==7.10.3

29− || ==8.0.2

30− || ==8.2.2

31− || ==8.4.4

32− || ==8.6.5

27+ GHC ==8.6.5

33 || ==8.8.4

28 || ==8.8.4

34− || ==8.10.2

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

36library

37 default-language: Haskell2010

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

48 Database.PostgreSQL.Simple.HStore.Internal

49 Database.PostgreSQL.Simple.Internal

50 Database.PostgreSQL.Simple.LargeObjects

51+ Database.PostgreSQL.Simple.Newtypes

51 Database.PostgreSQL.Simple.Notification

52 Database.PostgreSQL.Simple.Notification

52 Database.PostgreSQL.Simple.Ok

53 Database.PostgreSQL.Simple.Ok

53 Database.PostgreSQL.Simple.Range

54 Database.PostgreSQL.Simple.Range

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

76

77

77 -- GHC bundled libs

78 -- GHC bundled libs

78 build-depends:

79 build-depends:

79− base >=4.6.0.0 && <4.15

80+ base >=4.12.0.0 && <4.20

80− , bytestring >=0.10.0.0 && <0.12

81+ , bytestring >=0.10.8.2 && <0.13

81− , containers >=0.5.0.0 && <0.7

82+ , containers >=0.6.0.1 && <0.7

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

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

83− , text >=1.2.3.0 && <1.3

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

84− , time >=1.4.0.1 && <1.12

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

85− , transformers >=0.3.0.0 && <0.6

86+ , transformers >=0.5.6.2 && <0.7

86

87

87 -- Other dependencies

88 -- Other dependencies

88 build-depends:

89 build-depends:

89− aeson >=1.4.1.0 && <1.6

90+ aeson >=2.1.2.1 && <2.3

90− , attoparsec >=0.13.2.2 && <0.14

91+ , attoparsec >=0.14.4 && <0.15

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

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

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

93− , hashable >=1.2.7.0 && <1.4

93+ , hashable >=1.4.3.0 && <1.5

94− , Only >=0.1 && <0.1.1

94+ , Only >=0.1 && <0.1.1

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

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

96− , scientific >=0.3.6.2 && <0.4

96+ , scientific >=0.3.7.0 && <0.4

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

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

98− , vector >=0.12.0.1 && <0.13

98+ , vector >=0.13.0.0 && <0.14

99−

100− if !impl(ghc >=8.0)

101− build-depends:

102− fail >=4.9.0.0 && <4.10

103− , semigroups >=0.18.5 && <0.20

104−

105− if !impl(ghc >=7.6)

106− build-depends: ghc-prim

107

99

108 default-extensions:

100 default-extensions:

109 BangPatterns

101 BangPatterns

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

116

108

117source-repository head

109source-repository head

118 type: git

110 type: git

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

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

120−

121−source-repository this

122− type: git

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

124− tag: v0.6

125

112

126test-suite inspection

113test-suite inspection

127− if !impl(ghc >=8.0)

128− buildable: False

129−

130 default-language: Haskell2010

114 default-language: Haskell2010

131 type: exitcode-stdio-1.0

115 type: exitcode-stdio-1.0

132 hs-source-dirs: test

116 hs-source-dirs: test

133 main-is: Inspection.hs

117 main-is: Inspection.hs

134 build-depends:

118 build-depends:

135 base

119 base

136− , inspection-testing >=0.4.1.1 && <0.5

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

137 , postgresql-libpq

121 , postgresql-libpq

138 , postgresql-simple

122 , postgresql-simple

139 , tasty

123 , tasty

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

146 main-is: Main.hs

130 main-is: Main.hs

147 other-modules:

131 other-modules:

148 Common

132 Common

133+ Exception

134+ Interval

149 Notify

135 Notify

150 Serializable

136 Serializable

151 Time

137 Time

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

175 , tasty-golden

161 , tasty-golden

176 , tasty-hunit

162 , tasty-hunit

177 , text

163 , text

178− , time

164+ , time-compat

179 , vector

165 , vector

180

166

181− if !impl(ghc >=7.6)

182− build-depends: ghc-prim

183−

184benchmark select

167benchmark select

185 default-language: Haskell2010

168 default-language: Haskell2010

186 type: exitcode-stdio-1.0

169 type: exitcode-stdio-1.0

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

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

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67+ , SomePostgreSqlException(..)

67 , SqlError(..)

68 , SqlError(..)

68 , PQ.ExecStatus(..)

69 , PQ.ExecStatus(..)

69 , FormatError(..)

70 , FormatError(..)

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

73 , Base.connectPostgreSQL

74 , Base.connectPostgreSQL

74 , Base.close

75 , Base.close

75 , Base.connect

76 , Base.connect

77+ , Base.withConnect

76 , Base.ConnectInfo(..)

78 , Base.ConnectInfo(..)

77 , Base.defaultConnectInfo

79 , Base.defaultConnectInfo

78 , Base.postgreSQLConnectionString

80 , Base.postgreSQLConnectionString

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

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

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

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

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

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

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

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

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

904--

906--

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

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

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

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

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

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

12 ) where

13

14import qualified Control.Exception as E

15−import Data.Monoid

16import Data.ByteString (ByteString)

15import Data.ByteString (ByteString)

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

18import Data.ByteString.Lazy (toStrict)

16import Data.ByteString.Lazy (toStrict)

19−#else

20−import qualified Data.ByteString as B

21−import Data.ByteString.Lazy (toChunks)

22−#endif

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

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

24−

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

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

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

27−#else

28−import Data.Scientific (scientificBuilder)

29−#endif

30−

31−#if __GLASGOW_HASKELL__ >= 702

32import System.IO.Unsafe (unsafeDupablePerformIO)

19import System.IO.Unsafe (unsafeDupablePerformIO)

33−#elif __GLASGOW_HASKELL__ >= 611

34−import GHC.IO (unsafeDupablePerformIO)

35−#else

36−import GHC.IOBase (unsafeDupablePerformIO)

37−#endif

38−

39import Data.Fixed (Pico)

20import Data.Fixed (Pico)

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

41import Data.Fixed (Fixed(MkFixed))

21import Data.Fixed (Fixed(MkFixed))

42−#else

43−import Unsafe.Coerce (unsafeCoerce)

44−#endif

45

22

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

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

47--

24--

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

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

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

52-- don't need that polymorphism.

29-- don't need that polymorphism.

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

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

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

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

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

61{-# INLINE mask #-}

32{-# INLINE mask #-}

62

33

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−

71toByteString :: Builder -> ByteString

34toByteString :: Builder -> ByteString

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

73toByteString x = toStrict (toLazyByteString x)

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

79

36

80toPico :: Integer -> Pico

37toPico :: Integer -> Pico

81toPico = MkFixed

38toPico = MkFixed

82

39

83fromPico :: Pico -> Integer

40fromPico :: Pico -> Integer

84fromPico (MkFixed i) = i

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

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

32 ( copy

33 , copy_

34 , CopyOutResult(..)

35+ , foldCopyData

35 , getCopyData

36 , getCopyData

36 , putCopyData

37 , putCopyData

37 , putCopyEnd

38 , putCopyEnd

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

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

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

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

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

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

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

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

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

58

59

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

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

60copy conn template qs = do

61copy conn template qs = do

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

85 PQ.TuplesOk -> err

86 PQ.TuplesOk -> err

86 PQ.CopyOut -> return ()

87 PQ.CopyOut -> return ()

87 PQ.CopyIn -> return ()

88 PQ.CopyIn -> return ()

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

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

90−#endif

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

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

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

93−#endif

94 PQ.BadResponse -> throwResultError funcName result status

91 PQ.BadResponse -> throwResultError funcName result status

95 PQ.NonfatalError -> throwResultError funcName result status

92 PQ.NonfatalError -> throwResultError funcName result status

96 PQ.FatalError -> throwResultError funcName result status

93 PQ.FatalError -> throwResultError funcName result status

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

104 deriving (Eq, Typeable, Show)

101 deriving (Eq, Typeable, Show)

105

102

106

103

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

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

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

107+--

108+-- __Example__

109+--

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

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

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

113+-- > []

114+

115+foldCopyData

116+ :: Connection -- ^ Database connection

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

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

119+ -> a -- ^ Initial accumulator

120+ -> IO b -- ^ Result

121+foldCopyData conn f g !acc = do

122+ result <- getCopyData conn

123+ case result of

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

125+ CopyOutDone count -> g acc count

126+

127+

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

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

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

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

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

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

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

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

25 )

26 where

27

28−import Control.Applicative

29import Control.Exception as E

28import Control.Exception as E

30

29

31import Data.Attoparsec.ByteString.Char8

30import Data.Attoparsec.ByteString.Char8

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

60 deriving (Show, Eq, Ord, Typeable)

59 deriving (Show, Eq, Ord, Typeable)

61

60

62-- Default instance should be enough

61-- Default instance should be enough

63−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

64

65

66

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

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

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

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

68--

69--

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

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

70-- > where

71-- > where

src/Database/PostgreSQL/Simple/FromField.hs+17−6

@@ -118,10 +118,8 @@ module Database.PostgreSQL.Simple.FromField

118

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

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

121−import Control.Exception (Exception)

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

122import qualified Data.Aeson as JSON

123−import qualified Data.Aeson.Internal as JSON

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

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

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

126import Data.ByteString (ByteString)

124import Data.ByteString (ByteString)

127import qualified Data.ByteString.Char8 as B

125import qualified Data.ByteString.Char8 as B

@@ -129,7 +127,7 @@ import Data.Functor.Identity (Identity(Identity))

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

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

130import Data.IORef (IORef, newIORef)

128import Data.IORef (IORef, newIORef)

131import Data.Ratio (Ratio)

129import Data.Ratio (Ratio)

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

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

133import Data.Typeable (Typeable, typeOf)

131import Data.Typeable (Typeable, typeOf)

134import Data.Vector (Vector)

132import Data.Vector (Vector)

135import Data.Vector.Mutable (IOVector)

133import Data.Vector.Mutable (IOVector)

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

156import Data.Scientific (Scientific)

154import Data.Scientific (Scientific)

157import GHC.Real (infinity, notANumber)

155import GHC.Real (infinity, notANumber)

158

156

157+import qualified Data.Aeson.Types as JSON

158+

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

160-- value fails.

161data ResultError = Incompatible { errSQLType :: String

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

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

183 deriving (Eq, Show, Typeable)

184

185−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

186

188

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

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

188left = conversionError

190left = conversionError

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

487instance FromField Date where

489instance FromField Date where

488 fromField = ff TI.dateOid "Date" parseDate

490 fromField = ff TI.dateOid "Date" parseDate

489

491

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

493+--

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

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

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

497+--

498+instance FromField CalendarDiffTime where

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

500+

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

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

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

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

492ff compatOid hsType parseBS f mstr =

503ff compatOid hsType parseBS f mstr =

@@ -565,7 +576,7 @@ instance FromField UUID where

565-- | json, jsonb

576-- | json, jsonb

566instance FromField JSON.Value where

577instance FromField JSON.Value where

567 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs

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

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

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

569 Left err -> returnError ConversionFailed f err

580 Left err -> returnError ConversionFailed f err

570 Right val -> pure val

581 Right val -> pure val

571

582

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

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

22import qualified Data.ByteString.Builder as BU

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

24import qualified Data.ByteString.Lazy as BL

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

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

27−#endif

28import Data.Map(Map)

25import Data.Map(Map)

29import qualified Data.Map as Map

26import qualified Data.Map as Map

30import Data.Text(Text)

27import Data.Text(Text)

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

69

66

70instance Monoid HStoreBuilder where

67instance Monoid HStoreBuilder where

71 mempty = Empty

68 mempty = Empty

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

73− mappend = (<>)

74−#endif

75

69

76class ToHStoreText a where

70class ToHStoreText a where

77 toHStoreText :: a -> HStoreText

71 toHStoreText :: a -> HStoreText

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

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

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

2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

4

6

5------------------------------------------------------------------------------

7------------------------------------------------------------------------------

6-- |

8-- |

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

34import qualified Data.IntMap as IntMap

36import qualified Data.IntMap as IntMap

35import Data.IORef

37import Data.IORef

36import Data.Maybe(fromMaybe)

38import Data.Maybe(fromMaybe)

37−import Data.Monoid

38import Data.String

39import Data.String

39import qualified Data.Text as T

40import qualified Data.Text as T

40import qualified Data.Text.Encoding as TE

41import qualified Data.Text.Encoding as TE

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

82instance Eq Connection where

83instance Eq Connection where

83 x == y = connectionHandle x == connectionHandle y

84 x == y = connectionHandle x == connectionHandle y

84

85

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+

85data SqlError = SqlError {

105data SqlError = SqlError {

86 sqlState :: ByteString

106 sqlState :: ByteString

87 , sqlExecStatus :: ExecStatus

107 , sqlExecStatus :: ExecStatus

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

93fatalError :: ByteString -> SqlError

113fatalError :: ByteString -> SqlError

94fatalError msg = SqlError "" FatalError msg "" ""

114fatalError msg = SqlError "" FatalError msg "" ""

95

115

96−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

97

120

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

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

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

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

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

102 , qeQuery :: Query

125 , qeQuery :: Query

103 } deriving (Eq, Show, Typeable)

126 } deriving (Eq, Show, Typeable)

104

127

105−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

106

131

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

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

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

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

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

113 , fmtParams :: [ByteString]

138 , fmtParams :: [ByteString]

114 } deriving (Eq, Show, Typeable)

139 } deriving (Eq, Show, Typeable)

115

140

116−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

117

144

118data ConnectInfo = ConnectInfo {

145data ConnectInfo = ConnectInfo {

119 connectHost :: String

146 connectHost :: String

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

155connect :: ConnectInfo -> IO Connection

182connect :: ConnectInfo -> IO Connection

156connect = connectPostgreSQL . postgreSQLConnectionString

183connect = connectPostgreSQL . postgreSQLConnectionString

157

184

185+-- | Memory bracket around 'connect' and 'close'.

186+--

187+-- @since 0.6.5

188+withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c

189+withConnect connInfo = bracket (connect connInfo) close

190+

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

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

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

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

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

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

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

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

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

485

518

486instance Monad Conversion where

519instance Monad Conversion where

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

488− return = pure

489−#endif

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

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

491 oka <- runConversion m conn

521 oka <- runConversion m conn

492 case oka of

522 case oka of

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

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

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

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

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

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

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

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

81−#endif

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

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

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

84−#endif

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

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

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

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

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

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

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

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

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE DeriveDataTypeable #-}

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

4+--

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

6+module Database.PostgreSQL.Simple.Newtypes (

7+ Aeson (..), getAeson,

8+) where

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,8 +47,6 @@ import GHC.IO.Exception ( ioe_location )

47

48#if defined(mingw32_HOST_OS)

49import Control.Concurrent ( threadDelay )

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

51−import Control.Concurrent ( threadWaitRead )

52#else

50#else

53import GHC.Conc ( atomically )

51import GHC.Conc ( atomically )

54import Control.Concurrent ( threadWaitReadSTM )

52import Control.Concurrent ( threadWaitReadSTM )

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

94 -- with async exceptions, whereas threadDelay can.

92 -- with async exceptions, whereas threadDelay can.

95 Just _fd -> do

93 Just _fd -> do

96 return (threadDelay 1000000 >> loop)

94 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

112#else

95#else

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

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

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

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

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

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

72 mplus = (<|>)

73

74instance Monad Ok where

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

76− return = pure

77−#endif

78−

79 Errors es >>= _ = Errors es

75 Errors es >>= _ = Errors es

80 Ok a >>= f = f a

76 Ok a >>= f = f a

81

77

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

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

38import Data.Scientific (Scientific)

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

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

41−import Data.Time (Day, LocalTime,

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

42 NominalDiffTime,

43 TimeOfDay, UTCTime,

44 ZonedTime,

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

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

227 , parseUTCTimestamp

228 , parseZonedTimestamp

229 , parseLocalTimestamp

230+ , parseCalendarDiffTime

230 , dayToBuilder

231 , dayToBuilder

231 , utcTimeToBuilder

232 , utcTimeToBuilder

232 , zonedTimeToBuilder

233 , zonedTimeToBuilder

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

239 , localTimestampToBuilder

240 , localTimestampToBuilder

240 , unboundedToBuilder

241 , unboundedToBuilder

241 , nominalDiffTimeToBuilder

242 , nominalDiffTimeToBuilder

243+ , calendarDiffTimeToBuilder

242 ) where

244 ) where

243

245

244import Database.PostgreSQL.Simple.Time.Implementation

246import Database.PostgreSQL.Simple.Time.Implementation

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

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

18import Control.Arrow((***))

19import Control.Applicative

20import qualified Data.ByteString as B

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

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

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

22import Data.Typeable

23import Data.Typeable

23import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

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

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

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

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

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

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

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

79

80

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

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

83+

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

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

81getUnbounded getFinite

85getUnbounded getFinite

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

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

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

125getUTCTimestamp :: A.Parser UTCTimestamp

129getUTCTimestamp :: A.Parser UTCTimestamp

126getUTCTimestamp = getUnbounded getUTCTime

130getUTCTimestamp = getUnbounded getUTCTime

127

131

132+getCalendarDiffTime :: A.Parser CalendarDiffTime

133+getCalendarDiffTime = TP.calendarDiffTime

134+

128dayToBuilder :: Day -> Builder

135dayToBuilder :: Day -> Builder

129dayToBuilder = primBounded TPP.day

136dayToBuilder = primBounded TPP.day

130

137

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

164

171

165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

166nominalDiffTimeToBuilder = TPP.nominalDiffTime

173nominalDiffTimeToBuilder = TPP.nominalDiffTime

174+

175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

176+calendarDiffTimeToBuilder = TPP.calendarDiffTime

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

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

21 , localToUTCTimeOfDayHMS

22 , utcTime

23 , zonedTime

24+ , calendarDiffTime

24 ) where

25 ) where

25

26

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

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

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

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

28import Data.Attoparsec.ByteString.Char8 as A

29import Data.Attoparsec.ByteString.Char8 as A

29import Data.Bits ((.&.))

30import Data.Bits ((.&.))

31+import Data.ByteString (ByteString)

30import Data.Char (ord)

32import Data.Char (ord)

31import Data.Fixed (Pico)

33import Data.Fixed (Pico)

32import Data.Int (Int64)

34import Data.Int (Int64)

33import Data.Maybe (fromMaybe)

35import Data.Maybe (fromMaybe)

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

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

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

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

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

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

36import qualified Data.ByteString.Char8 as B8

40import qualified Data.ByteString.Char8 as B8

37−import qualified Data.Time.LocalTime as Local

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

38

42

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

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

40day :: Parser Day

44day :: Parser Day

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

193

197

194utc :: Local.TimeZone

198utc :: Local.TimeZone

195utc = Local.TimeZone 0 False ""

199utc = Local.TimeZone 0 False ""

200+

201+calendarDiffTime :: Parser CalendarDiffTime

202+calendarDiffTime = do

203+ contents <- takeByteString

204+ iso8601ParseM $ B8.unpack contents

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

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

17 , localTime

18 , zonedTime

19 , nominalDiffTime

20+ , calendarDiffTime

20 ) where

21 ) where

21

22

22import Control.Arrow ((>>>))

23import Control.Arrow ((>>>))

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

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

24import Data.ByteString.Builder.Prim

25import Data.ByteString.Builder.Prim

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

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

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

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

27import Data.Char ( chr )

28import Data.Char ( chr )

28import Data.Int ( Int32, Int64 )

29import Data.Int ( Int32, Int64 )

29−import Data.Time

30+import Data.String (fromString)

31+import Data.Time.Compat

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

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

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

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

32 , TimeZone, timeZoneMinutes )

34 , TimeZone, timeZoneMinutes )

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

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

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

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

34import Unsafe.Coerce (unsafeCoerce)

38import Unsafe.Coerce (unsafeCoerce)

35

39

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

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

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

122 where

126 where

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

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

128+

129+calendarDiffTime :: CalendarDiffTime -> Builder

130+calendarDiffTime = byteString

131+ . fromString

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

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

134+ -- to ASCII output.

135+ . iso8601Show

src/Database/PostgreSQL/Simple/ToField.hs+8−8

@@ -36,7 +36,8 @@ import Data.Functor.Identity (Identity(Identity))

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

37import Data.List (intersperse)

38import Data.Monoid (mappend)

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

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

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

40import Data.Typeable (Typeable)

41import Data.Typeable (Typeable)

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

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

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

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

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

58import qualified Database.PostgreSQL.LibPQ as PQ

59import qualified Database.PostgreSQL.LibPQ as PQ

59import Database.PostgreSQL.Simple.Time

60import Database.PostgreSQL.Simple.Time

60import Data.Scientific (Scientific)

61import Data.Scientific (Scientific)

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

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

63−#else

64−import Data.Scientific (scientificBuilder)

65−#endif

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

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

67

64

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

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

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

293 toField = Plain . inQuotes . nominalDiffTimeToBuilder

290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

294 {-# INLINE toField #-}

291 {-# INLINE toField #-}

295

292

293+instance ToField CalendarDiffTime where

294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

295+ {-# INLINE toField #-}

296+

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

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

297 toField pgArray =

298 toField pgArray =

298 case fromPGArray pgArray of

299 case fromPGArray pgArray of

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

313instance ToField JSON.Value where

314instance ToField JSON.Value where

314 toField = toField . JSON.encode

315 toField = toField . JSON.encode

315

316

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

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

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

318--

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

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

321-- PostgreSQL.

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

323−toJSONField = toField . JSON.toJSON

323+toJSONField = toField . JSON.encode

324

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

326--

src/Database/PostgreSQL/Simple/Transaction.hs+14−9

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

17 , withTransactionLevel

18 , withTransactionMode

19 , withTransactionModeRetry

20+ , withTransactionModeRetry'

20 , withTransactionSerializable

21 , withTransactionSerializable

21 , TransactionMode(..)

22 , TransactionMode(..)

22 , IsolationLevel(..)

23 , IsolationLevel(..)

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

146 commit conn

147 commit conn

147 return r

148 return r

148

149

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

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

152+withTransactionModeRetry = withTransactionModeRetry'

153+

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

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

150−-- determine if a transaction should be retried if an 'SqlError' occurs.

155+-- determine if a transaction should be retried if an exception occurs.

151−-- If the callback returns True, then the transaction will be retried.

156+-- If the callback returns 'True', then the transaction will be retried.

152−-- If the callback returns False, or an exception other than an 'SqlError'

157+-- If the callback returns 'False', or an exception other than an @e@

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

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

154--

159--

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

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

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

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

157−withTransactionModeRetry mode shouldRetry conn act =

162+withTransactionModeRetry' mode shouldRetry conn act =

158 mask $ \restore ->

163 mask $ \restore ->

159 retryLoop $ E.try $ do

164 retryLoop $ E.try $ do

160 a <- restore act `E.onException` rollback_ conn

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

161 commit conn

166 commit conn

162 return a

167 return a

163 where

168 where

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

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

165 retryLoop act' = do

170 retryLoop act' = do

166 beginMode mode conn

171 beginMode mode conn

167 r <- act'

172 r <- act'

168 case r of

173 case r of

169 Left e ->

174 Left e ->

170− case fmap shouldRetry (E.fromException e) of

175+ case shouldRetry e of

171− Just True -> retryLoop act'

176+ True -> retryLoop act'

172− _ -> E.throwIO e

177+ False -> E.throwIO e

173 Right a ->

178 Right a ->

174 return a

179 return a

175

180

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

@@ -50,10 +50,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

50data Null = Null

51 deriving (Read, Show, Typeable)

52

53−instance Eq Null where

54− _ == _ = False

55− _ /= _ = False

56−

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

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

58data Default = Default

54data Default = Default

59 deriving (Read, Show, Typeable)

55 deriving (Read, Show, Typeable)

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

97

93

98instance Monoid Query where

94instance Monoid Query where

99 mempty = Query B.empty

95 mempty = Query B.empty

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

101− mappend = (<>)

102−#endif

103

96

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

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

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

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

test/Exception.hsnew file+70

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

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

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.hsnew file+176

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

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

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

3{-# LANGUAGE DeriveDataTypeable #-}

4{-# LANGUAGE DoAndIfThenElse #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6+#if __GLASGOW_HASKELL__ >= 806

7+{-# LANGUAGE DerivingStrategies #-}

8+{-# LANGUAGE DerivingVia #-}

9+{-# LANGUAGE DeriveAnyClass #-}

10+#endif

11+module Main (main) where

12+

6import Common

13import Common

7import Database.PostgreSQL.Simple.Copy

14import Database.PostgreSQL.Simple.Copy

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

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

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

9import Database.PostgreSQL.Simple.HStore

17import Database.PostgreSQL.Simple.HStore

18+import Database.PostgreSQL.Simple.Newtypes

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

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

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

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

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

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

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

15import Control.Exception as E

24import Control.Exception as E

16import Control.Monad

25import Control.Monad

17import Data.Char

26import Data.Char

27+import Data.Foldable (toList)

18import Data.List (concat, sort)

28import Data.List (concat, sort)

19import Data.IORef

29import Data.IORef

20import Data.Monoid ((<>))

30import Data.Monoid ((<>))

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

36import qualified Data.Vector as V

46import qualified Data.Vector as V

37import System.FilePath

47import System.FilePath

38import System.Timeout(timeout)

48import System.Timeout(timeout)

39−import Data.Time(getCurrentTime, diffUTCTime)

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

40import System.Environment (getEnvironment)

50import System.Environment (getEnvironment)

41

51

42import Test.Tasty

52import Test.Tasty

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

44import Notify

54import Notify

45import Serializable

55import Serializable

46import Time

56import Time

57+import Interval

58+import Exception (testExceptions)

47

59

48tests :: TestEnv -> TestTree

60tests :: TestEnv -> TestTree

49tests env = testGroup "tests"

61tests env = testGroup "tests"

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

54 , testCase "Notify" . testNotify

66 , testCase "Notify" . testNotify

55 , testCase "Serializable" . testSerializable

67 , testCase "Serializable" . testSerializable

56 , testCase "Time" . testTime

68 , testCase "Time" . testTime

69+ , testCase "Interval" . testInterval

57 , testCase "Array" . testArray

70 , testCase "Array" . testArray

58 , testCase "Array of nullables" . testNullableArray

71 , testCase "Array of nullables" . testNullableArray

59 , testCase "HStore" . testHStore

72 , testCase "HStore" . testHStore

60 , testCase "citext" . testCIText

73 , testCase "citext" . testCIText

61 , testCase "JSON" . testJSON

74 , testCase "JSON" . testJSON

75+ , testCase "Aeson newtype" . testAeson

76+ , testCase "DerivingVia" . testDerivingVia

62 , testCase "Question mark escape" . testQM

77 , testCase "Question mark escape" . testQM

63 , testCase "Savepoint" . testSavepoint

78 , testCase "Savepoint" . testSavepoint

64 , testCase "Unicode" . testUnicode

79 , testCase "Unicode" . testUnicode

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

70 , testCase "2-ary generic" . testGeneric2

85 , testCase "2-ary generic" . testGeneric2

71 , testCase "3-ary generic" . testGeneric3

86 , testCase "3-ary generic" . testGeneric3

72 , testCase "Timeout" . testTimeout

87 , testCase "Timeout" . testTimeout

88+ , testCase "Exceptions" . testExceptions

73 ]

89 ]

74

90

75testBytea :: TestEnv -> TestTree

91testBytea :: TestEnv -> TestTree

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

123 xs <- readIORef ref

139 xs <- readIORef ref

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

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

125 xs <- readIORef ref

141 xs <- readIORef ref

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

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

127

143

128 -- Make sure fold propagates our exception.

144 -- Make sure fold propagates our exception.

129 ref <- newIORef []

145 ref <- newIORef []

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

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

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

241 [js] @?= js'

257 [js] @?= js'

242

258

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+

243testQM :: TestEnv -> Assertion

293testQM :: TestEnv -> Assertion

244testQM TestEnv{..} = do

294testQM TestEnv{..} = do

245 -- Just test on a single string

295 -- Just test on a single string

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

397 -- so that we can issue more queries:

447 -- so that we can issue more queries:

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

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

399 x @?= 4

449 x @?= 4

450+ -- foldCopyData

451+ copy_ conn "COPY copy_test TO STDOUT (FORMAT CSV)"

452+ (acc, count) <- foldCopyData conn

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

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

455+ []

456+ sort acc @?= sort copyRows

457+ count @?= 2

400 where

458 where

401 copyRows = ["1,foo\n"

459 copyRows = ["1,foo\n"

402 ,"2,bar\n"]

460 ,"2,bar\n"]

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

416

474

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

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

418goldenTest testName =

476goldenTest testName =

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

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

420 where

478 where

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

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

422 fileName = map normalize testName

480 fileName = map normalize testName

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

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

424 | otherwise = c

482 | otherwise = c

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

425

484

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

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

427testCopyUniqueConstraintError :: TestEnv -> TestTree

486testCopyUniqueConstraintError :: TestEnv -> TestTree

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

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

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

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

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

552withTestEnv connstr cb =

611withTestEnv connstr cb =

553− withConn $ \conn ->

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+

554 cb TestEnv

617 cb TestEnv

555 { conn = conn

618 { conn = conn

556 , withConn = withConn

619 , withConn = withConn

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

559 withConn = bracket (connectPostgreSQL connstr) close

622 withConn = bracket (connectPostgreSQL connstr) close

560

623

561main :: IO ()

624main :: IO ()

562−main = do

625+main = withConnstring $ \connstring -> do

626+ withTestEnv connstring (defaultMain . tests)

627+

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

629+withConnstring kont = do

563 env <- getEnvironment

630 env <- getEnvironment

564 case lookup "DATABASE_CONNSTRING" env of

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)

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

635+ _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"

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

567− where

636+ where

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

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

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

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

570 special "travis" = ""

639 special "travis" = ""

571 special s = s

640 special s = s

641+

642+ gha = unwords

643+ [ "dbname='postgres'"

644+ , "user='postgres'"

645+ , "password='postgres'"

646+ , "host='postgres'"

647+ , "port=5432"

648+ ]

test/Time.hs+1−1

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

36

37import Common

38import Control.Monad(forM_, replicateM_)

39−import Data.Time

39+import Data.Time.Compat

40import Data.ByteString(ByteString)

41import Database.PostgreSQL.Simple.SqlQQ

42

test/results/malformed-input.expected+1−1

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

1user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2−Connection error: ERROR: invalid input syntax for integer: "z"

2+Connection error: ERROR: invalid input syntax for type integer: "z"

3CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

4)