master..f55c9db · typeable/http-api-data

git.iko.soy/typeable/http-api-data

.ghcinew file+1

@@ -0,0 +1 @@

1+:set -itest -isrc -optP-include -optP .stack-work/dist/x86_64-osx/Cabal-1.24.0.0/build/autogen/cabal_macros.h -optP-I -optPinclude

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

@@ -1,283 +0,0 @@

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

2−#

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

4−#

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

6−#

7−# haskell-ci regenerate

8−#

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

10−#

11−# version: 0.15.20220609

12−#

13−# REGENDATA ("0.15.20220609",["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− continue-on-error: ${{ matrix.allow-failure }}

32− strategy:

33− matrix:

34− include:

35− - compiler: ghc-9.4.0.20220523

36− compilerKind: ghc

37− compilerVersion: 9.4.0.20220523

38− setup-method: ghcup

39− allow-failure: true

40− - compiler: ghc-9.2.3

41− compilerKind: ghc

42− compilerVersion: 9.2.3

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-9.0.2

46− compilerKind: ghc

47− compilerVersion: 9.0.2

48− setup-method: ghcup

49− allow-failure: false

50− - compiler: ghc-8.10.7

51− compilerKind: ghc

52− compilerVersion: 8.10.7

53− setup-method: ghcup

54− allow-failure: false

55− - compiler: ghc-8.8.4

56− compilerKind: ghc

57− compilerVersion: 8.8.4

58− setup-method: hvr-ppa

59− allow-failure: false

60− - compiler: ghc-8.6.5

61− compilerKind: ghc

62− compilerVersion: 8.6.5

63− setup-method: hvr-ppa

64− allow-failure: false

65− - compiler: ghc-8.4.4

66− compilerKind: ghc

67− compilerVersion: 8.4.4

68− setup-method: hvr-ppa

69− allow-failure: false

70− - compiler: ghc-8.2.2

71− compilerKind: ghc

72− compilerVersion: 8.2.2

73− setup-method: hvr-ppa

74− allow-failure: false

75− - compiler: ghc-8.0.2

76− compilerKind: ghc

77− compilerVersion: 8.0.2

78− setup-method: hvr-ppa

79− allow-failure: false

80− fail-fast: false

81− steps:

82− - name: apt

83− run: |

84− apt-get update

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

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

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

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

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

90− if $HEADHACKAGE; then "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; fi

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

92− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.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.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup"

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

100− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.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/$HCKIND-$HCVER

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

116− echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"

117− echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

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

119− else

120− HC=$HCDIR/bin/$HCKIND

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

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

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

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

125− fi

126−

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

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

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

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

131− if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi

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

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

134− env:

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

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

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

138− - name: env

139− run: |

140− env

141− - name: write cabal config

142− run: |

143− mkdir -p $CABAL_DIR

144− cat >> $CABAL_CONFIG <<EOF

145− remote-build-reporting: anonymous

146− write-ghc-environment-files: never

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

148− logs-dir: $CABAL_DIR/logs

149− world-file: $CABAL_DIR/world

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

151− symlink-bindir: $CABAL_DIR/bin

152− installdir: $CABAL_DIR/bin

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

154− store-dir: $CABAL_DIR/store

155− install-dirs user

156− prefix: $CABAL_DIR

157− repository hackage.haskell.org

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

159− EOF

160− if $HEADHACKAGE; then

161− cat >> $CABAL_CONFIG <<EOF

162− repository head.hackage.ghc.haskell.org

163− url: https://ghc.gitlab.haskell.org/head.hackage/

164− secure: True

165− root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d

166− 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329

167− f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89

168− key-threshold: 3

169− active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override

170− EOF

171− fi

172− cat >> $CABAL_CONFIG <<EOF

173− program-default-options

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

175− EOF

176− cat $CABAL_CONFIG

177− - name: versions

178− run: |

179− $HC --version || true

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

181− $CABAL --version || true

182− - name: update cabal index

183− run: |

184− $CABAL v2-update -v

185− - name: cache (tools)

186− uses: actions/cache@v2

187− with:

188− key: ${{ runner.os }}-${{ matrix.compiler }}-tools-445c2459

189− path: ~/.haskell-ci-tools

190− - name: install cabal-plan

191− run: |

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

193− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz

194− echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -

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

196− rm -f cabal-plan.xz

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

198− cabal-plan --version

199− - name: install doctest

200− run: |

201− if [ $((HCNUMVER < 90000)) -ne 0 ] ; then $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.20' ; fi

202− if [ $((HCNUMVER < 90000)) -ne 0 ] ; then doctest --version ; fi

203− - name: checkout

204− uses: actions/checkout@v2

205− with:

206− path: source

207− - name: initial cabal.project for sdist

208− run: |

209− touch cabal.project

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

211− cat cabal.project

212− - name: sdist

213− run: |

214− mkdir -p sdist

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

216− - name: unpack

217− run: |

218− mkdir -p unpacked

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

220− - name: generate cabal.project

221− run: |

222− PKGDIR_http_api_data="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/http-api-data-[0-9.]*')"

223− echo "PKGDIR_http_api_data=${PKGDIR_http_api_data}" >> "$GITHUB_ENV"

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

225− touch cabal.project

226− touch cabal.project.local

227− echo "packages: ${PKGDIR_http_api_data}" >> cabal.project

228− if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package http-api-data" >> cabal.project ; fi

229− if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi

230− cat >> cabal.project <<EOF

231− EOF

232− if $HEADHACKAGE; then

233− echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project

234− fi

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

236− cat cabal.project

237− cat cabal.project.local

238− - name: dump install plan

239− run: |

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

241− cabal-plan

242− - name: cache

243− uses: actions/cache@v2

244− with:

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

246− path: ~/.cabal/store

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

248− - name: install dependencies

249− run: |

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

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

252− - name: build w/o tests

253− run: |

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

255− - name: build

256− run: |

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

258− - name: tests

259− run: |

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

261− - name: doctest

262− run: |

263− perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat)-\d+(\.\d+)*/; }' .ghc.environment.*

264− if [ $((HCNUMVER < 90000)) -ne 0 ] ; then cd ${PKGDIR_http_api_data} || false ; fi

265− if [ $((HCNUMVER < 90000)) -ne 0 ] ; then doctest -XHaskell2010 src/ ; fi

266− - name: cabal check

267− run: |

268− cd ${PKGDIR_http_api_data} || false

269− ${CABAL} -vnormal check

270− - name: haddock

271− run: |

272− $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

273− - name: unconstrained build

274− run: |

275− rm -f cabal.project.local

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

277− - name: prepare for constraint sets

278− run: |

279− rm -f cabal.project.local

280− - name: constraint set text-show

281− run: |

282− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='http-api-data +use-text-show' --dependencies-only -j2 all

283− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='http-api-data +use-text-show' all

.gitignore−1

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

1/dist/

2/dist-newstyle/

3−/.ghc.environment.*

4/.shelly/

3/.shelly/

5/tarballs/

4/tarballs/

6*.swp

5*.swp

.travis.ymlnew file+109

@@ -0,0 +1,109 @@

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

2+#

3+# make_travis_yml_2.hs 'http-api-data.cabal'

4+#

5+# For more information, see https://github.com/hvr/multi-ghc-travis

6+#

7+language: c

8+sudo: false

10+git:

11+ submodules: false # whether to recursively clone submodules

12+

13+cache:

14+ directories:

15+ - $HOME/.cabal/packages

16+ - $HOME/.cabal/store

17+

18+before_cache:

19+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

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

21+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

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

26+

27+matrix:

28+ include:

29+ - compiler: "ghc-7.8.4"

30+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

31+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}

32+ - compiler: "ghc-7.10.3"

33+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

34+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}

35+ - compiler: "ghc-8.0.2"

36+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

38+ - compiler: "ghc-head"

39+ env: CABALFLAGS="--allow-newer"

40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

41+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}

42+

43+ allow_failures:

44+ - compiler: "ghc-head"

45+

46+before_install:

47+ - HC=${CC}

48+ - unset CC

49+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH

50+ - PKGNAME='http-api-data'

51+

52+install:

53+ - cabal --version

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

55+ - BENCH=${BENCH---enable-benchmarks}

56+ - TEST=${TEST---enable-tests}

57+ - travis_retry cabal update -v

58+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

59+ # Soon we'll have build-tool-depends: in cabal-head

60+ - cabal get hspec-discover-2.3.2

61+ - cd hspec-discover-2.3.2

62+ - cabal new-build hspec-discover:exe:hspec-discover

63+ - mkdir -p ~/.local/bin

64+ - shopt -s globstar; cp dist-newstyle/**/hspec-discover/hspec-discover ~/.local/bin

65+ - cd ..

66+ # Continue

67+ - rm -fv cabal.project.local

68+ - "echo 'packages: .' > cabal.project"

69+ - rm -f cabal.project.freeze

70+ - cabal new-build ${CABALFLAGS} -w ${HC} ${TEST} ${BENCH} --dep -j2

71+ - cabal new-build ${CABALFLAGS} -w ${HC} --disable-tests --disable-benchmarks --dep -j2

72+

73+# Here starts the actual work to be performed for the package under test;

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

75+script:

76+ - if [ -f configure.ac ]; then autoreconf -i; fi

77+ - rm -rf dist/

78+ - cabal sdist # test that a source-distribution can be generated

79+ - cd dist/

80+ - SRCTAR=(${PKGNAME}-*.tar.gz)

81+ - SRC_BASENAME="${SRCTAR/%.tar.gz}"

82+ - tar -xvf "./$SRC_BASENAME.tar.gz"

83+ - cd "$SRC_BASENAME/"

84+## from here on, CWD is inside the extracted source-tarball

85+ - rm -fv cabal.project.local

86+ - "echo 'packages: .' > cabal.project"

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

88+ - rm -f cabal.project.freeze

89+ - cabal new-build ${CABALFLAGS} -w ${HC} --disable-tests --disable-benchmarks

90+ - cabal new-build ${CABALFLAGS} -w ${HC} --disable-tests --disable-benchmarks --flag http-api-data:use-text-show

91+ # this builds all libraries and executables (including tests/benchmarks)

92+ # - rm -rf ./dist-newstyle

93+ - cabal new-build ${CABALFLAGS} -w ${HC} ${TEST} ${BENCH}

94+

95+ # there's no 'cabal new-test' yet, so let's emulate for now

96+ - TESTS=( $(awk 'tolower($0) ~ /^test-suite / { print $2 }' *.cabal) )

97+ - if [ "$TEST" != "--enable-tests" ]; then TESTS=(); fi

98+ - shopt -s globstar;

99+ RC=true; for T in ${TESTS[@]}; do echo "== $T ==";

100+ if dist-newstyle/build/**/$SRC_BASENAME/**/build/$T/$T; then echo "= $T OK =";

101+ else echo "= $T FAILED ="; RC=false; fi; done; $RC

102+

103+ - cabal new-build ${CABALFLAGS} -w ${HC} ${TEST} ${BENCH} --flag http-api-data:use-text-show

104+ - shopt -s globstar;

105+ RC=true; for T in ${TESTS[@]}; do echo "== $T ==";

106+ if dist-newstyle/build/**/$SRC_BASENAME/**/build/$T/$T; then echo "= $T OK =";

107+ else echo "= $T FAILED ="; RC=false; fi; done; $RC

108+

109+# EOF

CHANGELOG.md−97

@@ -1,100 +1,3 @@

1−0.5

2−---

3−

4−* Use `attoparsec-iso8601-1.1.0.0`.

5− `Day` and `UTCTime` parsers require at least 4 digits now, which is a breaking change.

6−* Drop GHC-7.8 and GHC-7.10 support.

7−

8−0.4.3

9−-----

10−

11−* Add `Quarter`, `QuarterOfYear` and `Month` instances

12−* Support `bytestring-0.11`

13−

14−0.4.2

15−-----

16−

17−* Add instances for `Const` and `Identity`

18−

19−0.4.1.1

20−-------

21−

22−* Allow cookie <0.5

23−* Change to `build-type: Simple`

24−

25−0.4.1

26−-----

27−

28−* Use `time-compat` to provide instances for `DayOfWeek`.

29−

30−0.4

31−---

32−

33−* `NominalDiffTime` instances preserve precision (roundtrip)

34−* Add `Semigroup.Min`, `Max`, `First`, `Last` instances

35−* Add `Tagged b a` instances

36−

37−0.3.10

38−---

39−

40−* Fix 'SetCookie' instances

41− (see [#86](https://github.com/fizruk/http-api-data/pull/86))

42−* Add support for `Fixed`

43− (see [#78](https://github.com/fizruk/http-api-data/pull/87))

44−

45−0.3.9

46−---

47−

48−* GHC-8.6 support

49−* Remove dependency on `uri-bytestring` and use functions from `http-types` instead

50− (see [#75](https://github.com/fizruk/http-api-data/pull/75))

51−* Add support for `SetCookie`

52− (see [#74](https://github.com/fizruk/http-api-data/pull/74))

53−

54−0.3.8.1

55−---

56−

57−* GHC-8.4.1 support

58−

59−0.3.8

60−---

61−

62−* Minor changes:

63− * Stable URL-encoding for `Form`s (see [#67](https://github.com/fizruk/http-api-data/pull/67)):

64− * Introduce `urlEncodeParams` and `urlDecodeParams`;

65− * Introduce `urlEncodeAsFormStable` and use stable encoding for doctests;

66− * Add `toEntriesByKeyStable` and `toListStable`;

67− * Add `Semigroup` instance for `Form` (see [#69](https://github.com/fizruk/http-api-data/pull/69));

68− * Relax upper bound on Cabal (see [#73](https://github.com/fizruk/http-api-data/pull/73)).

69−

70−0.3.7.2

71−---

72−

73−* Allow http-types-0.12

74−* .cabal file adjustments

75−

76−0.3.7.1

77−---

78−

79−* GHC-8.2 support (see [#55](https://github.com/fizruk/http-api-data/pull/55)).

80−

81−0.3.7

82−---

83−

84−* Minor changes:

85− * Use [`attoparsec-iso8601`](http://hackage.haskell.org/package/attoparsec-iso8601)

86− for parsing of time types. Now the accepted formats are the same as by `aeson`,

87− i.e. parsers are more lenient

88− (see [#41](https://github.com/fizruk/http-api-data/pull/41));

89− * Preserve fractions of a second in `ToHttpApiData` instances (see [#53](https://github.com/fizruk/http-api-data/pull/53));

90− * Add `ToHttpApiData` and `FromHttpApiData` instances for `TimeOfDay` (see [#53](https://github.com/fizruk/http-api-data/pull/53)).

91−

92−0.3.6

93−---

94−

95−* Minor change:

96− * Add `toEncodedUrlPiece` class method for URL-encoded path segments (see [#50](https://github.com/fizruk/http-api-data/pull/50)); use efficient encoding for types whose values don't need URL-encoding.

97−

980.3.5

10.3.5

99---

2---

100

Setup.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Distribution.Simple

2−main = defaultMain

Setup.lhsnew file+165

@@ -0,0 +1,165 @@

1+\begin{code}

2+{-# LANGUAGE CPP #-}

3+#ifndef MIN_VERSION_Cabal

4+#define MIN_VERSION_Cabal(x,y,z) 0

5+#endif

6+#ifndef MIN_VERSION_directory

7+#define MIN_VERSION_directory(x,y,z) 0

8+#endif

9+#if MIN_VERSION_Cabal(1,24,0)

10+#define InstalledPackageId UnitId

11+#endif

12+module Main (main) where

13+

14+import Control.Monad ( when )

15+import Data.List ( nub )

16+import Distribution.Package ( InstalledPackageId )

17+import Distribution.Package ( PackageId, Package (..), packageVersion )

18+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))

19+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )

20+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )

21+import Distribution.Simple.BuildPaths ( autogenModulesDir )

22+import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)

23+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )

24+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))

25+import Distribution.Text ( display , simpleParse )

26+import System.FilePath ( (</>) )

27+

28+#if MIN_VERSION_Cabal(1,25,0)

29+import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )

30+#endif

31+

32+#if MIN_VERSION_directory(1,2,2)

33+import System.Directory (makeAbsolute)

34+#else

35+import System.Directory (getCurrentDirectory)

36+import System.FilePath (isAbsolute)

37+

38+makeAbsolute :: FilePath -> IO FilePath

39+makeAbsolute p | isAbsolute p = return p

40+ | otherwise = do

41+ cwd <- getCurrentDirectory

42+ return $ cwd </> p

43+#endif

44+

45+main :: IO ()

46+main = defaultMainWithHooks simpleUserHooks

47+ { buildHook = \pkg lbi hooks flags -> do

48+ generateBuildModule flags pkg lbi

49+ buildHook simpleUserHooks pkg lbi hooks flags

50+ }

51+

52+generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()

53+generateBuildModule flags pkg lbi = do

54+ let verbosity = fromFlag (buildVerbosity flags)

55+ let distPref = fromFlag (buildDistPref flags)

56+

57+ -- Package DBs

58+ let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]

59+ let dbFlags = "-hide-all-packages" : packageDbArgs dbStack

60+

61+ withLibLBI pkg lbi $ \lib libcfg -> do

62+ let libBI = libBuildInfo lib

63+

64+ -- modules

65+ let modules = exposedModules lib ++ otherModules libBI

66+ -- it seems that doctest is happy to take in module names, not actual files!

67+ let module_sources = modules

68+

69+ -- We need the directory with library's cabal_macros.h!

70+#if MIN_VERSION_Cabal(1,25,0)

71+ let libAutogenDir = autogenComponentModulesDir lbi libcfg

72+#else

73+ let libAutogenDir = autogenModulesDir lbi

74+#endif

75+

76+ -- Lib sources and includes

77+ iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI

78+ includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI

79+

80+ -- CPP includes, i.e. include cabal_macros.h

81+ let cppFlags = map ("-optP"++) $

82+ [ "-include", libAutogenDir ++ "/cabal_macros.h" ]

83+ ++ cppOptions libBI

84+

85+ -- Actually we need to check whether testName suite == "doctests"

86+ -- pending https://github.com/haskell/cabal/pull/4229 getting into GHC HEAD tree

87+ withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == testName suite) $ do

88+

89+ -- get and create autogen dir

90+#if MIN_VERSION_Cabal(1,25,0)

91+ let testAutogenDir = autogenComponentModulesDir lbi suitecfg

92+#else

93+ let testAutogenDir = autogenModulesDir lbi

94+#endif

95+ createDirectoryIfMissingVerbose verbosity True testAutogenDir

96+

97+ -- write autogen'd file

98+ rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines

99+ [ "module Build_doctests where"

100+ , ""

101+ -- -package-id etc. flags

102+ , "pkgs :: [String]"

103+ , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)

104+ , ""

105+ , "flags :: [String]"

106+ , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)

107+ , ""

108+ , "module_sources :: [String]"

109+ , "module_sources = " ++ show (map display module_sources)

110+ ]

111+ where

112+ -- we do this check in Setup, as then doctests don't need to depend on Cabal

113+ isOldCompiler = maybe False id $ do

114+ a <- simpleParse $ showCompilerId $ compiler lbi

115+ b <- simpleParse "7.5"

116+ return $ packageVersion (a :: PackageId) < b

117+

118+ formatDeps = map formatOne

119+ formatOne (installedPkgId, pkgId)

120+ -- The problem is how different cabal executables handle package databases

121+ -- when doctests depend on the library

122+ | packageId pkg == pkgId = "-package=" ++ display pkgId

123+ | otherwise = "-package-id=" ++ display installedPkgId

124+

125+ -- From Distribution.Simple.Program.GHC

126+ packageDbArgs :: [PackageDB] -> [String]

127+ packageDbArgs | isOldCompiler = packageDbArgsConf

128+ | otherwise = packageDbArgsDb

129+

130+ -- GHC <7.6 uses '-package-conf' instead of '-package-db'.

131+ packageDbArgsConf :: [PackageDB] -> [String]

132+ packageDbArgsConf dbstack = case dbstack of

133+ (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs

134+ (GlobalPackageDB:dbs) -> ("-no-user-package-conf")

135+ : concatMap specific dbs

136+ _ -> ierror

137+ where

138+ specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]

139+ specific _ = ierror

140+ ierror = error $ "internal error: unexpected package db stack: "

141+ ++ show dbstack

142+

143+ -- GHC >= 7.6 uses the '-package-db' flag. See

144+ -- https://ghc.haskell.org/trac/ghc/ticket/5977.

145+ packageDbArgsDb :: [PackageDB] -> [String]

146+ -- special cases to make arguments prettier in common scenarios

147+ packageDbArgsDb dbstack = case dbstack of

148+ (GlobalPackageDB:UserPackageDB:dbs)

149+ | all isSpecific dbs -> concatMap single dbs

150+ (GlobalPackageDB:dbs)

151+ | all isSpecific dbs -> "-no-user-package-db"

152+ : concatMap single dbs

153+ dbs -> "-clear-package-db"

154+ : concatMap single dbs

155+ where

156+ single (SpecificPackageDB db) = [ "-package-db=" ++ db ]

157+ single GlobalPackageDB = [ "-global-package-db" ]

158+ single UserPackageDB = [ "-user-package-db" ]

159+ isSpecific (SpecificPackageDB _) = True

160+ isSpecific _ = False

161+

162+testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]

163+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys

164+

165+\end{code}

cabal.haskell-cideleted−6

@@ -1,6 +0,0 @@

1−branches: master

2−doctest: <9

3−doctest-filter-packages: base-compat

4−

5−constraint-set text-show

6− constraints: http-api-data +use-text-show

cabal.projectdeleted−2

@@ -1,2 +0,0 @@

1−packages: .

2−tests: True

http-api-data.cabal+48−60

@@ -1,38 +1,33 @@

1−cabal-version: >= 1.10

2name: http-api-data

1name: http-api-data

3−version: 0.5

2+version: 0.3.5

4−

5−synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.

6−category: Web

7−description:

8− This package defines typeclasses used for converting Haskell data types to and from HTTP API data.

9− .

10− Please see README.md

11−

12license: BSD3

3license: BSD3

13license-file: LICENSE

4license-file: LICENSE

14author: Nickolay Kudasov <nickolay.kudasov@gmail.com>

5author: Nickolay Kudasov <nickolay.kudasov@gmail.com>

15maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>

6maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>

7+synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.

8+description: Please see README.md

16homepage: http://github.com/fizruk/http-api-data

9homepage: http://github.com/fizruk/http-api-data

10+category: Web

17stability: unstable

11stability: unstable

12+cabal-version: >= 1.10

18−build-type: Simple

13+build-type: Custom

19−

20extra-source-files:

14extra-source-files:

21 include/overlapping-compat.h

15 include/overlapping-compat.h

22 test/*.hs

16 test/*.hs

23 CHANGELOG.md

17 CHANGELOG.md

24 README.md

18 README.md

25−

26tested-with:

19tested-with:

20+ GHC==7.8.4,

21+ GHC==7.10.3,

27 GHC==8.0.2,

22 GHC==8.0.2,

28− GHC==8.2.2,

23+ GHC==8.1.*

29− GHC==8.4.4,

24+

30− GHC==8.6.5,

25+custom-setup

31− GHC==8.8.4,

26+ setup-depends:

32− GHC==8.10.7,

27+ base >= 4.7 && <4.10,

33− GHC==9.0.2,

28+ Cabal >= 1.18 && <1.26,

34− GHC==9.2.3,

29+ filepath,

35− GHC==9.4.1

30+ directory

37flag use-text-show

32flag use-text-show

38 description: Use text-show library for efficient ToHttpApiData implementations.

33 description: Use text-show library for efficient ToHttpApiData implementations.

@@ -42,31 +37,19 @@ flag use-text-show

42library

37library

43 hs-source-dirs: src/

38 hs-source-dirs: src/

44 include-dirs: include/

39 include-dirs: include/

45−

46− -- GHC bundled

47− build-depends: base >= 4.9 && < 4.17

40+ build-depends: base >= 4.7 && < 4.10

48− , bytestring >= 0.10.8.1 && < 0.12

41+ , bytestring

49− , containers >= 0.5.7.1 && < 0.7

42+ , containers

50− , text >= 1.2.3.0 && < 1.3 || >=2.0 && <2.1

51− , transformers >= 0.5.2.0 && < 0.7

52−

53− -- other-dependencies

54− build-depends:

55− attoparsec >= 0.13.2.2 && < 0.15

56− , attoparsec-iso8601 >= 1.1.0.0 && < 1.2

57− , base-compat >= 0.10.5 && < 0.13

58− , cookie >= 0.4.3 && < 0.5

59− , hashable >= 1.2.7.0 && < 1.5

43+ , hashable

60− , http-types >= 0.12.3 && < 0.13

44+ , text >= 0.5

61− , tagged >= 0.8.5 && < 0.9

45+ , time

62− , time-compat >= 1.9.5 && < 1.10

46+ , time-locale-compat >=0.1.1.0 && <0.2

63− , unordered-containers >= 0.2.10.0 && < 0.3

47+ , unordered-containers

48+ , uri-bytestring

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

49+ , uuid-types >= 1.0.2 && <1.1

65−

66 if flag(use-text-show)

50 if flag(use-text-show)

67 cpp-options: -DUSE_TEXT_SHOW

51 cpp-options: -DUSE_TEXT_SHOW

68− build-depends: text-show >= 3.8.2 && <3.10

52+ build-depends: text-show >= 2

69−

70 exposed-modules:

53 exposed-modules:

71 Web.HttpApiData

54 Web.HttpApiData

72 Web.FormUrlEncoded

55 Web.FormUrlEncoded

@@ -85,26 +68,31 @@ test-suite spec

85 hs-source-dirs: test

68 hs-source-dirs: test

86 ghc-options: -Wall

69 ghc-options: -Wall

87 default-language: Haskell2010

70 default-language: Haskell2010

88− build-tool-depends: hspec-discover:hspec-discover >= 2.7.1 && <2.11

71+ build-depends: HUnit

89− -- inherited depndencies

72+ , hspec >= 1.3

90− build-depends:

73+ , base >= 4 && < 5

91− base

92− , base-compat

93 , bytestring

74 , bytestring

94− , cookie

75+ , QuickCheck >=2.9

76+ , quickcheck-instances >= 0.3.12

77+ , unordered-containers

95 , http-api-data

78 , http-api-data

96 , text

79 , text

97− , time-compat

80+ , time

98− , unordered-containers

81+ , bytestring

99− , uuid-types

82+ , uuid

100−

101− if !impl(ghc >= 7.10)

102− build-depends: nats

103

84+test-suite doctests

85+ ghc-options: -Wall

86+ build-tools: hsc2hs

104− build-depends: HUnit >= 1.6.0.0 && <1.7

87+ build-depends:

105− , hspec >= 2.7.1 && <2.11

88+ base,

106− , QuickCheck >= 2.13.1 && <2.15

89+ directory >= 1.0,

107− , quickcheck-instances >= 0.3.25.2 && <0.4

90+ doctest >= 0.11 && <0.12,

91+ filepath

92+ default-language: Haskell2010

93+ hs-source-dirs: test

94+ main-is: DocTest.hs

95+ type: exitcode-stdio-1.0

108

109source-repository head

97source-repository head

110 type: git

98 type: git

src/Web/FormUrlEncoded.hs+1−8

@@ -14,11 +14,9 @@ module Web.FormUrlEncoded (

15 -- * Encoding and decoding @'Form'@s

16 urlEncodeAsForm,

17− urlEncodeAsFormStable,

18 urlDecodeAsForm,

17 urlDecodeAsForm,

20 urlEncodeForm,

19 urlEncodeForm,

21− urlEncodeFormStable,

22 urlDecodeForm,

20 urlDecodeForm,

24 -- * 'Generic's

22 -- * 'Generic's

@@ -30,9 +28,7 @@ module Web.FormUrlEncoded (

30 defaultFormOptions,

28 defaultFormOptions,

32 -- * Helpers

30 -- * Helpers

33− toListStable,

34 toEntriesByKey,

31 toEntriesByKey,

35− toEntriesByKeyStable,

36 fromEntriesByKey,

32 fromEntriesByKey,

38 lookupAll,

34 lookupAll,

@@ -42,10 +38,7 @@ module Web.FormUrlEncoded (

42 parseAll,

38 parseAll,

43 parseMaybe,

39 parseMaybe,

44 parseUnique,

40 parseUnique,

45−

46− urlEncodeParams,

47− urlDecodeParams,

48) where

41) where

50−import Web.Internal.FormUrlEncoded

43+import Web.Internal.FormUrlEncoded

src/Web/HttpApiData.hs+3−2

@@ -43,15 +43,16 @@ module Web.HttpApiData (

43 readTextData,

44) where

46−import Web.Internal.HttpApiData

46+import Web.Internal.HttpApiData

48-- $setup

49--

50-- >>> :set -XOverloadedStrings

51-- >>> import Control.Applicative

52−-- >>> import Data.Time.Compat

52+-- >>> import Data.Time

53-- >>> import Data.Int

54-- >>> import Data.Text (Text)

55+-- >>> import Data.Time (Day)

55-- >>> import Data.Version

56-- >>> import Data.Version

57-- $examples

58-- $examples

src/Web/Internal/FormUrlEncoded.hs+59−141

@@ -17,51 +17,50 @@

17#include "overlapping-compat.h"

18module Web.Internal.FormUrlEncoded where

20−import Prelude ()

20+#if __GLASGOW_HASKELL__ < 710

21−import Prelude.Compat

21+import Control.Applicative

22+import Data.Traversable

23+#endif

24+

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

24import Control.Arrow ((***))

26import Control.Arrow ((***))

25import Control.Monad ((<=<))

27import Control.Monad ((<=<))

26−import Data.ByteString.Builder (shortByteString, toLazyByteString)

28+import Data.ByteString.Builder (toLazyByteString, shortByteString)

27import qualified Data.ByteString.Lazy as BSL

29import qualified Data.ByteString.Lazy as BSL

28import qualified Data.ByteString.Lazy.Char8 as BSL8

30import qualified Data.ByteString.Lazy.Char8 as BSL8

29−import Data.Coerce (coerce)

30import qualified Data.Foldable as F

31import qualified Data.Foldable as F

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

32import Data.Hashable (Hashable)

33import Data.HashMap.Strict (HashMap)

34import qualified Data.HashMap.Strict as HashMap

35−import Data.Int (Int16, Int32, Int64, Int8)

35+import Data.Int

36import Data.IntMap (IntMap)

37import qualified Data.IntMap as IntMap

38−import Data.List (intersperse, sortBy)

38+import Data.List (intersperse)

39import Data.Map (Map)

40import qualified Data.Map as Map

41−import Data.Monoid (All (..), Any (..), Dual (..),

41+import Data.Monoid

42− Product (..), Sum (..))

42+

43−import Data.Ord (comparing)

44−import Data.Proxy (Proxy (..))

45−import Data.Semigroup (Semigroup (..))

46−import qualified Data.Semigroup as Semi

47−import Data.Tagged (Tagged (..))

48import Data.Text (Text)

43import Data.Text (Text)

49import qualified Data.Text as Text

44import qualified Data.Text as Text

50−import qualified Data.Text.Encoding as Text

51−import Data.Text.Encoding.Error (lenientDecode)

52import qualified Data.Text.Lazy as Lazy

45import qualified Data.Text.Lazy as Lazy

53−import Data.Time.Compat (Day, LocalTime, NominalDiffTime,

46+import Data.Text.Encoding as Text

54− UTCTime, ZonedTime)

47+import Data.Text.Encoding.Error (lenientDecode)

55−import Data.Time.Calendar.Month.Compat (Month)

48+

56−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))

49+import Data.Time

57−import Data.Void (Void)

50+import Data.Proxy

58−import Data.Word (Word16, Word32, Word64, Word8)

51+import Data.Word

52+

53+#if MIN_VERSION_base(4,8,0)

54+import Data.Void

55+import Numeric.Natural

56+#endif

57+

59−import GHC.Exts (Constraint, IsList (..))

58+import GHC.Exts (IsList (..), Constraint)

60import GHC.Generics

59import GHC.Generics

61import GHC.TypeLits

60import GHC.TypeLits

62−import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)

61+import URI.ByteString (urlEncodeQuery, urlDecodeQuery)

63−import Numeric.Natural (Natural)

62+

64−import Web.Internal.HttpApiData

63+import Web.Internal.HttpApiData

66-- $setup

65-- $setup

67-- >>> :set -XDeriveGeneric

66-- >>> :set -XDeriveGeneric

@@ -115,9 +114,6 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam

115instance ToFormKey ZonedTime where toFormKey = toQueryParam

114instance ToFormKey ZonedTime where toFormKey = toQueryParam

116instance ToFormKey UTCTime where toFormKey = toQueryParam

115instance ToFormKey UTCTime where toFormKey = toQueryParam

117instance ToFormKey NominalDiffTime where toFormKey = toQueryParam

116instance ToFormKey NominalDiffTime where toFormKey = toQueryParam

118−instance ToFormKey Quarter where toFormKey = toQueryParam

119−instance ToFormKey QuarterOfYear where toFormKey = toQueryParam

120−instance ToFormKey Month where toFormKey = toQueryParam

121

117

122instance ToFormKey String where toFormKey = toQueryParam

118instance ToFormKey String where toFormKey = toQueryParam

123instance ToFormKey Text where toFormKey = toQueryParam

119instance ToFormKey Text where toFormKey = toQueryParam

@@ -126,26 +122,14 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam

126instance ToFormKey All where toFormKey = toQueryParam

122instance ToFormKey All where toFormKey = toQueryParam

127instance ToFormKey Any where toFormKey = toQueryParam

123instance ToFormKey Any where toFormKey = toQueryParam

128

124

129−instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)

125+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual

130−instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)

126+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum

131−instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text)

127+instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct

132−

133−instance ToFormKey a => ToFormKey (Semi.Min a) where toFormKey = coerce (toFormKey :: a -> Text)

134−instance ToFormKey a => ToFormKey (Semi.Max a) where toFormKey = coerce (toFormKey :: a -> Text)

135−instance ToFormKey a => ToFormKey (Semi.First a) where toFormKey = coerce (toFormKey :: a -> Text)

136−instance ToFormKey a => ToFormKey (Semi.Last a) where toFormKey = coerce (toFormKey :: a -> Text)

137−

138−instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text)

139−

140−-- | @since 0.4.2

141−instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text)

142−

143−-- | @since 0.4.2

144−instance ToFormKey a => ToFormKey (Const a b) where

145− toFormKey = coerce (toFormKey :: a -> Text)

146

128

129+#if MIN_VERSION_base(4,8,0)

147instance ToFormKey Void where toFormKey = toQueryParam

130instance ToFormKey Void where toFormKey = toQueryParam

148instance ToFormKey Natural where toFormKey = toQueryParam

131instance ToFormKey Natural where toFormKey = toQueryParam

132+#endif

149

133

150-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.

134-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.

151class FromFormKey k where

135class FromFormKey k where

@@ -177,9 +161,6 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam

177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam

161instance FromFormKey ZonedTime where parseFormKey = parseQueryParam

178instance FromFormKey UTCTime where parseFormKey = parseQueryParam

162instance FromFormKey UTCTime where parseFormKey = parseQueryParam

179instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam

163instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam

180−instance FromFormKey Quarter where parseFormKey = parseQueryParam

181−instance FromFormKey QuarterOfYear where parseFormKey = parseQueryParam

182−instance FromFormKey Month where parseFormKey = parseQueryParam

183

164

184instance FromFormKey String where parseFormKey = parseQueryParam

165instance FromFormKey String where parseFormKey = parseQueryParam

185instance FromFormKey Text where parseFormKey = parseQueryParam

166instance FromFormKey Text where parseFormKey = parseQueryParam

@@ -188,48 +169,30 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam

188instance FromFormKey All where parseFormKey = parseQueryParam

169instance FromFormKey All where parseFormKey = parseQueryParam

189instance FromFormKey Any where parseFormKey = parseQueryParam

170instance FromFormKey Any where parseFormKey = parseQueryParam

190

171

191−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

172+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey

192−instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

173+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey

193−instance FromFormKey a => FromFormKey (Product a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

194−

195−instance FromFormKey a => FromFormKey (Semi.Min a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

196−instance FromFormKey a => FromFormKey (Semi.Max a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

197−instance FromFormKey a => FromFormKey (Semi.First a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

198−instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

199−

200−instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

174+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey

201−

202−-- | @since 0.4.2

203−instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

204−

205−-- | @since 0.4.2

206−instance FromFormKey a => FromFormKey (Const a b) where

207− parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

208

175

176+#if MIN_VERSION_base(4,8,0)

209instance FromFormKey Void where parseFormKey = parseQueryParam

177instance FromFormKey Void where parseFormKey = parseQueryParam

210instance FromFormKey Natural where parseFormKey = parseQueryParam

178instance FromFormKey Natural where parseFormKey = parseQueryParam

179+#endif

211

180

212-- | The contents of a form, not yet URL-encoded.

181-- | The contents of a form, not yet URL-encoded.

213--

182--

214-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.

183-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.

215newtype Form = Form { unForm :: HashMap Text [Text] }

184newtype Form = Form { unForm :: HashMap Text [Text] }

216− deriving (Eq, Read, Generic, Semigroup, Monoid)

185+ deriving (Eq, Read, Generic, Monoid)

217

186

218instance Show Form where

187instance Show Form where

219 showsPrec d form = showParen (d > 10) $

188 showsPrec d form = showParen (d > 10) $

220− showString "fromList " . shows (toListStable form)

189+ showString "fromList " . shows (toList form)

221

190

222−-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).

223−-- For a stable conversion use 'toListStable'.

224instance IsList Form where

191instance IsList Form where

225 type Item Form = (Text, Text)

192 type Item Form = (Text, Text)

226 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))

193 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))

227 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm

194 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm

228

195

229−-- | A stable version of 'toList'.

230−toListStable :: Form -> [(Text, Text)]

231−toListStable = sortOn fst . toList

232−

233-- | Convert a value into 'Form'.

196-- | Convert a value into 'Form'.

234--

197--

235-- An example type and instance:

198-- An example type and instance:

@@ -340,7 +303,7 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint

340-- instance 'ToForm' Post

303-- instance 'ToForm' Post

341-- @

304-- @

342--

305--

343−-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }

306+-- >>> urlEncodeAsForm Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }

344-- "comments=Nice%20post%21&comments=%2B1&title=Test"

307-- "comments=Nice%20post%21&comments=%2B1&title=Test"

345genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form

308genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form

346genericToForm opts = gToForm (Proxy :: Proxy a) opts . from

309genericToForm opts = gToForm (Proxy :: Proxy a) opts . from

@@ -425,7 +388,6 @@ class FromForm a where

425

388

426instance FromForm Form where fromForm = pure

389instance FromForm Form where fromForm = pure

427

390

428−-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).

429instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where

391instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where

430 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey

392 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey

431

393

@@ -440,22 +402,13 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where

440

402

441-- | Parse a 'Form' into a list of entries groupped by key.

403-- | Parse a 'Form' into a list of entries groupped by key.

442--

404--

443−-- _NOTE:_ this conversion is unstable and may result in different key order

405+-- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]

444−-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.

406+-- Right [("color",["red","white"]),("name",["Nick"])]

445toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]

407toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]

446toEntriesByKey = traverse parseGroup . HashMap.toList . unForm

408toEntriesByKey = traverse parseGroup . HashMap.toList . unForm

447 where

409 where

448 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs

410 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs

449

411

450−-- | Parse a 'Form' into a list of entries groupped by key.

451−--

452−-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]

453−-- Right [("color",["red","white"]),("name",["Nick"])]

454−--

455−-- For an unstable (but faster) conversion see 'toEntriesByKey'.

456−toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]

457−toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey

458−

459-- | A 'Generic'-based implementation of 'fromForm'.

412-- | A 'Generic'-based implementation of 'fromForm'.

460-- This is used as a default implementation in 'FromForm'.

413-- This is used as a default implementation in 'FromForm'.

461--

414--

@@ -529,53 +482,39 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where

529

482

530-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.

483-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.

531--

484--

532−-- _NOTE:_ this encoding is unstable and may result in different key order

533−-- (but not values). For a stable encoding see 'urlEncodeFormStable'.

534−urlEncodeForm :: Form -> BSL.ByteString

535−urlEncodeForm = urlEncodeParams . toList

536−

537−-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.

538−--

539−-- For an unstable (but faster) encoding see 'urlEncodeForm'.

540−--

541-- Key-value pairs get encoded to @key=value@ and separated by @&@:

485-- Key-value pairs get encoded to @key=value@ and separated by @&@:

542--

486--

543−-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]

487+-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]

544-- "lastname=Arni&name=Julian"

488-- "lastname=Arni&name=Julian"

545--

489--

546-- Keys with empty values get encoded to just @key@ (without the @=@ sign):

490-- Keys with empty values get encoded to just @key@ (without the @=@ sign):

547--

491--

548−-- >>> urlEncodeFormStable [("is_test", "")]

492+-- >>> urlEncodeForm [("is_test", "")]

549-- "is_test"

493-- "is_test"

550--

494--

551-- Empty keys are allowed too:

495-- Empty keys are allowed too:

552--

496--

553−-- >>> urlEncodeFormStable [("", "foobar")]

497+-- >>> urlEncodeForm [("", "foobar")]

554-- "=foobar"

498-- "=foobar"

555--

499--

556−-- However, if both key and value are empty, the key-value pair is ignored.

500+-- However, if not key and value are empty, the key-value pair is ignored.

557−-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).

501+-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).

558--

502--

559−-- >>> urlEncodeFormStable [("", "")]

503+-- >>> urlEncodeForm [("", "")]

560-- ""

504-- ""

561--

505--

562-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:

506-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:

563--

507--

564−-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]

508+-- >>> urlEncodeForm [("fullname", "Andres Löh")]

565-- "fullname=Andres%20L%C3%B6h"

509-- "fullname=Andres%20L%C3%B6h"

566−urlEncodeFormStable :: Form -> BSL.ByteString

510+urlEncodeForm :: Form -> BSL.ByteString

567−urlEncodeFormStable = urlEncodeParams . sortOn fst . toList

568−

569−-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.

570−--

571−-- See also 'urlEncodeFormStable'.

572−urlEncodeParams :: [(Text, Text)] -> BSL.ByteString

573−urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair

511+urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList

574 where

512 where

575− escape = urlEncodeBuilder True . Text.encodeUtf8

513+ escape = urlEncodeQuery . Text.encodeUtf8

576

514

577 encodePair (k, "") = escape k

515 encodePair (k, "") = escape k

578− encodePair (k, v) = escape k <> shortByteString "=" <> escape v

516+ encodePair (k, v) = escape k <> shortByteString "=" <> escape v

517+

579

518

580-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.

519-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.

581--

520--

@@ -609,17 +548,11 @@ urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&")

609-- >>> urlDecodeForm "this=has=too=many=equals"

548-- >>> urlDecodeForm "this=has=too=many=equals"

610-- Left "not a valid pair: this=has=too=many=equals"

549-- Left "not a valid pair: this=has=too=many=equals"

611urlDecodeForm :: BSL.ByteString -> Either Text Form

550urlDecodeForm :: BSL.ByteString -> Either Text Form

612−urlDecodeForm = fmap toForm . urlDecodeParams

613−

614−-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs.

615−--

616−-- See also 'urlDecodeForm'.

617−urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)]

618−urlDecodeParams bs = traverse parsePair pairs

551+urlDecodeForm bs = toForm <$> traverse parsePair pairs

619 where

552 where

620 pairs = map (BSL8.split '=') (BSL8.split '&' bs)

553 pairs = map (BSL8.split '=') (BSL8.split '&' bs)

621

554

622− unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict

555+ unescape = Text.decodeUtf8With lenientDecode . urlDecodeQuery . BSL.toStrict

623

556

624 parsePair p =

557 parsePair p =

625 case map unescape p of

558 case map unescape p of

@@ -627,7 +560,6 @@ urlDecodeParams bs = traverse parsePair pairs

627 [k] -> return (k, "")

560 [k] -> return (k, "")

628 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs

561 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs

629

562

630−

631-- | This is a convenience function for decoding a

563-- | This is a convenience function for decoding a

632-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype

564-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype

633-- that has an instance of 'FromForm'.

565-- that has an instance of 'FromForm'.

@@ -645,22 +577,11 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm

645--

577--

646-- This is effectively @'urlEncodeForm' . 'toForm'@.

578-- This is effectively @'urlEncodeForm' . 'toForm'@.

647--

579--

648−-- _NOTE:_ this encoding is unstable and may result in different key order

580+-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}

649−-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.

581+-- "age=22&name=Dennis"

650urlEncodeAsForm :: ToForm a => a -> BSL.ByteString

582urlEncodeAsForm :: ToForm a => a -> BSL.ByteString

651urlEncodeAsForm = urlEncodeForm . toForm

583urlEncodeAsForm = urlEncodeForm . toForm

652

584

653−-- | This is a convenience function for encoding a datatype that has instance

654−-- of 'ToForm' directly to a @application/x-www-form-urlencoded@

655−-- 'BSL.ByteString'.

656−--

657−-- This is effectively @'urlEncodeFormStable' . 'toForm'@.

658−--

659−-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}

660−-- "age=22&name=Dennis"

661−urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString

662−urlEncodeAsFormStable = urlEncodeFormStable . toForm

663−

664-- | Find all values corresponding to a given key in a 'Form'.

585-- | Find all values corresponding to a given key in a 'Form'.

665--

586--

666-- >>> lookupAll "name" []

587-- >>> lookupAll "name" []

@@ -771,8 +692,8 @@ parseUnique key form = lookupUnique key form >>= parseQueryParam

771-- 'fromForm' = 'genericFromForm' myOptions

692-- 'fromForm' = 'genericFromForm' myOptions

772-- @

693-- @

773--

694--

774−-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }

695+-- >>> urlEncodeAsForm Project { projectName = "http-api-data", projectSize = 172 }

775−-- "name=http-api-data&size=172"

696+-- "size=172&name=http-api-data"

776-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project

697-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project

777-- Right (Project {projectName = "http-api-data", projectSize = 172})

698-- Right (Project {projectName = "http-api-data", projectSize = 172})

778data FormOptions = FormOptions

699data FormOptions = FormOptions

@@ -791,6 +712,3 @@ defaultFormOptions :: FormOptions

791defaultFormOptions = FormOptions

712defaultFormOptions = FormOptions

792 { fieldLabelModifier = id

713 { fieldLabelModifier = id

793 }

714 }

794−

795−sortOn :: Ord b => (a -> b) -> [a] -> [a]

796−sortOn f = sortBy (comparing f)

src/Web/Internal/HttpApiData.hs+108−367

@@ -1,86 +1,64 @@

1−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DefaultSignatures #-}

2+{-# LANGUAGE DefaultSignatures #-}

3−{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveDataTypeable #-}

4−{-# LANGUAGE DeriveFoldable #-}

5−{-# LANGUAGE DeriveFunctor #-}

4+{-# LANGUAGE DeriveFunctor #-}

5+{-# LANGUAGE DeriveFoldable #-}

6−{-# LANGUAGE DeriveTraversable #-}

6+{-# LANGUAGE DeriveTraversable #-}

7−{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE FlexibleInstances #-}

8−{-# LANGUAGE KindSignatures #-}

9−{-# LANGUAGE OverloadedStrings #-}

8+{-# LANGUAGE OverloadedStrings #-}

10−{-# LANGUAGE PolyKinds #-}

11−{-# LANGUAGE ScopedTypeVariables #-}

9+{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TypeSynonymInstances #-}

10{-# LANGUAGE TypeSynonymInstances #-}

13-- |

11-- |

14-- Convert Haskell values to and from HTTP API data

12-- Convert Haskell values to and from HTTP API data

15-- such as URL pieces, headers and query parameters.

13-- such as URL pieces, headers and query parameters.

16module Web.Internal.HttpApiData where

14module Web.Internal.HttpApiData where

18−import Prelude ()

16+#if __GLASGOW_HASKELL__ < 710

19−import Prelude.Compat

20−

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

17+import Control.Applicative

18+import Data.Foldable (Foldable)

19+import Data.Traversable (Traversable(traverse))

20+#endif

21+

22−import Control.Arrow (left, (&&&))

22+import Control.Arrow ((&&&), left)

23−import Control.Monad ((<=<))

23+import Control.Monad ((<=<))

24−import qualified Data.Attoparsec.Text as Atto

24+

25−import qualified Data.Attoparsec.Time as Atto

25+import Data.Monoid

26−import Data.ByteString (ByteString)

26+import Data.ByteString (ByteString)

27−import qualified Data.ByteString as BS

27+import qualified Data.ByteString as BS

28−import qualified Data.ByteString.Builder as BS

28+

29−import qualified Data.ByteString.Lazy as LBS

29+import Data.Int

30−import Data.Coerce (coerce)

30+import Data.Word

31−import Data.Data (Data)

31+

32−import qualified Data.Fixed as F

32+import Data.Text (Text)

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

34−import Data.Int (Int16, Int32, Int64, Int8)

35−import Data.Kind (Type)

36−import qualified Data.Map as Map

37−import Data.Monoid (All (..), Any (..), Dual (..),

38− First (..), Last (..),

39− Product (..), Sum (..))

40−import Data.Semigroup (Semigroup (..))

41−import qualified Data.Semigroup as Semi

42−import Data.Tagged (Tagged (..))

43−import Data.Text (Text)

44−import qualified Data.Text as T

33+import Data.Text.Encoding (encodeUtf8, decodeUtf8')

45−import Data.Text.Encoding (decodeUtf8', decodeUtf8With,

46− encodeUtf8)

47−import Data.Text.Encoding.Error (lenientDecode)

48−import qualified Data.Text.Lazy as L

49−import Data.Text.Read (Reader, decimal, rational,

34+import Data.Text.Read (signed, decimal, rational, Reader)

50− signed)

35+import qualified Data.Text as T

51−import Data.Time.Compat (Day, FormatTime, LocalTime,

36+import qualified Data.Text.Lazy as L

52− NominalDiffTime, TimeOfDay,

37+

53− UTCTime, ZonedTime, formatTime,

54− DayOfWeek (..),

55− nominalDiffTimeToSeconds,

56− secondsToNominalDiffTime)

57−import Data.Time.Format.Compat (defaultTimeLocale,

58− iso8601DateFormat)

59−import Data.Time.Calendar.Month.Compat (Month)

38+import Data.Time.Locale.Compat

60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),

39+import Data.Time

61− toYearQuarter)

62−import Data.Typeable (Typeable)

63−import qualified Data.UUID.Types as UUID

64−import Data.Version (Version, parseVersion,

40+import Data.Version

65− showVersion)

41+

66−import Data.Void (Void, absurd)

42+#if MIN_VERSION_base(4,8,0)

67−import Data.Word (Word16, Word32, Word64, Word8)

43+import Data.Void

68−import qualified Network.HTTP.Types as H

69−import Numeric.Natural (Natural)

44+import Numeric.Natural

45+#endif

46+

47+import Text.Read (readMaybe)

70−import Text.ParserCombinators.ReadP (readP_to_S)

48+import Text.ParserCombinators.ReadP (readP_to_S)

71−import Text.Read (readMaybe)

72−import Web.Cookie (SetCookie, parseSetCookie,

73− renderSetCookie)

75#if USE_TEXT_SHOW

50#if USE_TEXT_SHOW

76−import TextShow (TextShow, showt)

51+import TextShow (TextShow, showt)

77#endif

52#endif

54+import qualified Data.UUID.Types as UUID

55+

56+import Data.Typeable (Typeable)

57+import Data.Data (Data)

58+

79-- $setup

59-- $setup

80-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)

60-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)

81-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p

61-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p

82−-- >>> import Data.Time.Compat

83−-- >>> import Data.Version

85-- | Convert value to HTTP API data.

63-- | Convert value to HTTP API data.

86--

64--

@@ -92,12 +70,6 @@ class ToHttpApiData a where

92 toUrlPiece :: a -> Text

70 toUrlPiece :: a -> Text

93 toUrlPiece = toQueryParam

71 toUrlPiece = toQueryParam

95− -- | Convert to a URL path piece, making sure to encode any special chars.

96− -- The default definition uses 'H.encodePathSegmentsRelative',

97− -- but this may be overriden with a more efficient version.

98− toEncodedUrlPiece :: a -> BS.Builder

99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece

100−

101 -- | Convert to HTTP header value.

73 -- | Convert to HTTP header value.

102 toHeader :: a -> ByteString

74 toHeader :: a -> ByteString

103 toHeader = encodeUtf8 . toUrlPiece

75 toHeader = encodeUtf8 . toUrlPiece

@@ -338,7 +310,7 @@ lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])

338-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool

310-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool

339-- Right True

311-- Right True

340--

312--

341−-- For case insensitive parser see 'parseBoundedEnumOfI'.

313+-- For case sensitive parser see 'parseBoundedEnumOfI'.

342parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a

314parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a

343parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf

315parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf

344

316

@@ -383,7 +355,7 @@ parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of

383-- Right 1991-06-02

355-- Right 1991-06-02

384--

356--

385-- This parser is case sensitive and will not match @'showTextData'@

357-- This parser is case sensitive and will not match @'showTextData'@

386−-- in presence of letters:

358+-- in presense of letters:

387--

359--

388-- >>> readTextData (showTextData True) :: Either Text Bool

360-- >>> readTextData (showTextData True) :: Either Text Bool

389-- Left "could not parse: `true'"

361-- Left "could not parse: `true'"

@@ -415,193 +387,79 @@ parseBounded reader input = do

415 l = toInteger (minBound :: a)

387 l = toInteger (minBound :: a)

416 h = toInteger (maxBound :: a)

388 h = toInteger (maxBound :: a)

417

389

418−-- | Convert to a URL-encoded path piece using 'toUrlPiece'.

419−-- /Note/: this function does not check if the result contains unescaped characters!

420−-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation

421−-- when the resulting URL piece /never/ has to be escaped.

422−unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder

423−unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece

424−

425-- |

390-- |

426-- >>> toUrlPiece ()

391-- >>> toUrlPiece ()

427-- "_"

392-- "_"

428instance ToHttpApiData () where

393instance ToHttpApiData () where

429 toUrlPiece () = "_"

394 toUrlPiece () = "_"

430− toEncodedUrlPiece = unsafeToEncodedUrlPiece

431

395

432−instance ToHttpApiData Char where

396+instance ToHttpApiData Char where toUrlPiece = T.singleton

433− toUrlPiece = T.singleton

434

397

435-- |

398-- |

436-- >>> toUrlPiece (Version [1, 2, 3] [])

399-- >>> toUrlPiece (Version [1, 2, 3] [])

437-- "1.2.3"

400-- "1.2.3"

438instance ToHttpApiData Version where

401instance ToHttpApiData Version where

439 toUrlPiece = T.pack . showVersion

402 toUrlPiece = T.pack . showVersion

440− toEncodedUrlPiece = unsafeToEncodedUrlPiece

441

403

404+#if MIN_VERSION_base(4,8,0)

442instance ToHttpApiData Void where toUrlPiece = absurd

405instance ToHttpApiData Void where toUrlPiece = absurd

443−instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

406+instance ToHttpApiData Natural where toUrlPiece = showt

444−

407+#endif

408+

445−instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece

409+instance ToHttpApiData Bool where toUrlPiece = showTextData

446−instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece

410+instance ToHttpApiData Ordering where toUrlPiece = showTextData

447−

411+

448−instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

412+instance ToHttpApiData Double where toUrlPiece = showt

449−instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

413+instance ToHttpApiData Float where toUrlPiece = showt

450−instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

414+instance ToHttpApiData Int where toUrlPiece = showt

451−instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

415+instance ToHttpApiData Int8 where toUrlPiece = showt

452−instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

416+instance ToHttpApiData Int16 where toUrlPiece = showt

453−instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

417+instance ToHttpApiData Int32 where toUrlPiece = showt

454−instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

418+instance ToHttpApiData Int64 where toUrlPiece = showt

455−instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

419+instance ToHttpApiData Integer where toUrlPiece = showt

456−instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

420+instance ToHttpApiData Word where toUrlPiece = showt

457−instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

421+instance ToHttpApiData Word8 where toUrlPiece = showt

458−instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

422+instance ToHttpApiData Word16 where toUrlPiece = showt

459−instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

423+instance ToHttpApiData Word32 where toUrlPiece = showt

460−instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

424+instance ToHttpApiData Word64 where toUrlPiece = showt

461−

462−-- | Note: this instance is not polykinded

463−instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

464

425

465-- |

426-- |

466-- >>> toUrlPiece (fromGregorian 2015 10 03)

427-- >>> toUrlPiece (fromGregorian 2015 10 03)

467-- "2015-10-03"

428-- "2015-10-03"

468−instance ToHttpApiData Day where

429+instance ToHttpApiData Day where toUrlPiece = T.pack . show

469− toUrlPiece = T.pack . show

470− toEncodedUrlPiece = unsafeToEncodedUrlPiece

471

430

472timeToUrlPiece :: FormatTime t => String -> t -> Text

431timeToUrlPiece :: FormatTime t => String -> t -> Text

473timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))

432timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))

474

433

475-- |

434-- |

476−-- >>> toUrlPiece $ TimeOfDay 14 55 23.1

477−-- "14:55:23.1"

478−instance ToHttpApiData TimeOfDay where

479− toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"

480− toEncodedUrlPiece = unsafeToEncodedUrlPiece

481−

482−-- |

483−-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687)

435+-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)

484−-- "2015-10-03T14:55:21.687"

436+-- "2015-10-03T14:55:01"

485−instance ToHttpApiData LocalTime where

437+instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"

486− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"

487− toEncodedUrlPiece = unsafeToEncodedUrlPiece

488−

489−-- |

490−-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc

491−-- "2015-10-03T14:55:51.001+0000"

492−instance ToHttpApiData ZonedTime where

493− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"

494− toEncodedUrlPiece = unsafeToEncodedUrlPiece

495−

496−-- |

497−-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5

498−-- "2015-10-03T00:14:24.5Z"

499−instance ToHttpApiData UTCTime where

500− toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"

501− toEncodedUrlPiece = unsafeToEncodedUrlPiece

502

438

503-- |

439-- |

504−-- >>> toUrlPiece Monday

440+-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc

505−-- "monday"

441+-- "2015-10-03T14:55:01+0000"

506−instance ToHttpApiData DayOfWeek where

442+instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"

507− toUrlPiece Monday = "monday"

508− toUrlPiece Tuesday = "tuesday"

509− toUrlPiece Wednesday = "wednesday"

510− toUrlPiece Thursday = "thursday"

511− toUrlPiece Friday = "friday"

512− toUrlPiece Saturday = "saturday"

513− toUrlPiece Sunday = "sunday"

514−

515− toEncodedUrlPiece = unsafeToEncodedUrlPiece

516−

517−-- |

518−-- >>> toUrlPiece Q4

519−-- "q4"

520−instance ToHttpApiData QuarterOfYear where

521− toUrlPiece Q1 = "q1"

522− toUrlPiece Q2 = "q2"

523− toUrlPiece Q3 = "q3"

524− toUrlPiece Q4 = "q4"

525−

526−-- |

527−-- >>> import Data.Time.Calendar.Quarter.Compat (Quarter (..))

528−-- >>> MkQuarter 8040

529−-- 2010-Q1

530−--

531−-- >>> toUrlPiece $ MkQuarter 8040

532−-- "2010-q1"

533−--

534−instance ToHttpApiData Quarter where

535− toUrlPiece q = case toYearQuarter q of

536− (y, qoy) -> T.pack (show y ++ "-" ++ f qoy)

537− where

538− f Q1 = "q1"

539− f Q2 = "q2"

540− f Q3 = "q3"

541− f Q4 = "q4"

542

443

543-- |

444-- |

544−-- >>> import Data.Time.Calendar.Month.Compat (Month (..))

445+-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864

545−-- >>> MkMonth 24482

446+-- "2015-10-03T00:14:24Z"

546−-- 2040-03

547−--

548−-- >>> toUrlPiece $ MkMonth 24482

549−-- "2040-03"

550−--

551−instance ToHttpApiData Month where

447+instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"

552− toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"

553

448

554−instance ToHttpApiData NominalDiffTime where

449+instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)

555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds

556− toEncodedUrlPiece = unsafeToEncodedUrlPiece

557

450

558instance ToHttpApiData String where toUrlPiece = T.pack

451instance ToHttpApiData String where toUrlPiece = T.pack

559instance ToHttpApiData Text where toUrlPiece = id

452instance ToHttpApiData Text where toUrlPiece = id

560instance ToHttpApiData L.Text where toUrlPiece = L.toStrict

453instance ToHttpApiData L.Text where toUrlPiece = L.toStrict

561

454

562−instance ToHttpApiData All where

455+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll

563− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)

564− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)

565−

566−instance ToHttpApiData Any where

456+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny

567− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)

568− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)

569−

570−instance ToHttpApiData a => ToHttpApiData (Dual a) where

571− toUrlPiece = coerce (toUrlPiece :: a -> Text)

572− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

573−

574−instance ToHttpApiData a => ToHttpApiData (Sum a) where

575− toUrlPiece = coerce (toUrlPiece :: a -> Text)

576− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

577−

578−instance ToHttpApiData a => ToHttpApiData (Product a) where

579− toUrlPiece = coerce (toUrlPiece :: a -> Text)

580− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

581

457

582−instance ToHttpApiData a => ToHttpApiData (First a) where

458+instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual

583− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)

584− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)

585−

586−instance ToHttpApiData a => ToHttpApiData (Last a) where

587− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)

588− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)

589−

590−instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where

459+instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum

591− toUrlPiece = coerce (toUrlPiece :: a -> Text)

592− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

593−

594−instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where

460+instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct

595− toUrlPiece = coerce (toUrlPiece :: a -> Text)

596− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

597−

598−instance ToHttpApiData a => ToHttpApiData (Semi.First a) where

461+instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst

599− toUrlPiece = coerce (toUrlPiece :: a -> Text)

600− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

601−

602−instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where

462+instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast

603− toUrlPiece = coerce (toUrlPiece :: a -> Text)

604− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

605

463

606-- |

464-- |

607-- >>> toUrlPiece (Just "Hello")

465-- >>> toUrlPiece (Just "Hello")

@@ -619,41 +477,6 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where

619 toUrlPiece (Left x) = "left " <> toUrlPiece x

477 toUrlPiece (Left x) = "left " <> toUrlPiece x

620 toUrlPiece (Right x) = "right " <> toUrlPiece x

478 toUrlPiece (Right x) = "right " <> toUrlPiece x

621

479

622−-- | /Note:/ this instance works correctly for alphanumeric name and value

623−--

624−-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie

625−-- >>> toUrlPiece c

626−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

627−--

628−-- >>> toHeader c

629−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

630−--

631−instance ToHttpApiData SetCookie where

632− toUrlPiece = decodeUtf8With lenientDecode . toHeader

633− toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie

634− -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.

635−

636−-- | Note: this instance is not polykinded

637−instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where

638− toUrlPiece = coerce (toUrlPiece :: a -> Text)

639− toHeader = coerce (toHeader :: a -> ByteString)

640− toQueryParam = coerce (toQueryParam :: a -> Text)

641− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

642−

643−-- | @since 0.4.2

644−instance ToHttpApiData a => ToHttpApiData (Const a b) where

645− toUrlPiece = coerce (toUrlPiece :: a -> Text)

646− toHeader = coerce (toHeader :: a -> ByteString)

647− toQueryParam = coerce (toQueryParam :: a -> Text)

648− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

649−

650−-- | @since 0.4.2

651−instance ToHttpApiData a => ToHttpApiData (Identity a) where

652− toUrlPiece = coerce (toUrlPiece :: a -> Text)

653− toHeader = coerce (toHeader :: a -> ByteString)

654− toQueryParam = coerce (toQueryParam :: a -> Text)

655− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

656−

657-- |

480-- |

658-- >>> parseUrlPiece "_" :: Either Text ()

481-- >>> parseUrlPiece "_" :: Either Text ()

659-- Right ()

482-- Right ()

@@ -665,7 +488,7 @@ instance FromHttpApiData Char where

665 parseUrlPiece s =

488 parseUrlPiece s =

666 case T.uncons s of

489 case T.uncons s of

667 Just (c, s') | T.null s' -> pure c

490 Just (c, s') | T.null s' -> pure c

668− _ -> defaultParseError s

491+ _ -> defaultParseError s

669

492

670-- |

493-- |

671-- >>> showVersion <$> parseUrlPiece "1.2.3"

494-- >>> showVersion <$> parseUrlPiece "1.2.3"

@@ -676,6 +499,7 @@ instance FromHttpApiData Version where

676 ((x, ""):_) -> pure x

499 ((x, ""):_) -> pure x

677 _ -> defaultParseError s

500 _ -> defaultParseError s

678

501

502+#if MIN_VERSION_base(4,8,0)

679-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.

503-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.

680instance FromHttpApiData Void where

504instance FromHttpApiData Void where

681 parseUrlPiece _ = Left "Void cannot be parsed!"

505 parseUrlPiece _ = Left "Void cannot be parsed!"

@@ -686,6 +510,7 @@ instance FromHttpApiData Natural where

686 if n < 0

510 if n < 0

687 then Left ("underflow: " <> s <> " (should be a non-negative integer)")

511 then Left ("underflow: " <> s <> " (should be a non-negative integer)")

688 else Right (fromInteger n)

512 else Right (fromInteger n)

513+#endif

689

514

690instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

515instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

691instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

516instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

@@ -706,89 +531,41 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack

706instance FromHttpApiData Text where parseUrlPiece = Right

531instance FromHttpApiData Text where parseUrlPiece = Right

707instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict

532instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict

708

533

709−-- | Note: this instance is not polykinded

710−instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where

711− parseUrlPiece = runReader rational

712−

713-- |

534-- |

714-- >>> toGregorian <$> parseUrlPiece "2016-12-01"

535-- >>> toGregorian <$> parseUrlPiece "2016-12-01"

715-- Right (2016,12,1)

536-- Right (2016,12,1)

716−instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day

537+instance FromHttpApiData Day where parseUrlPiece = readTextData

717

538

718−-- |

539+timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t

719−-- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay

540+timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack)

720−-- Right 14:55:01.333

541+ where

721−instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay

542+ timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt))

722

543

723-- |

544-- |

724-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime

545-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime

725-- Right 2015-10-03 14:55:01

546-- Right 2015-10-03 14:55:01

726−instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime

547+instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S"

727

548

728-- |

549-- |

729-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime

550-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime

730-- Right 2015-10-03 14:55:01 +0000

551-- Right 2015-10-03 14:55:01 +0000

731−--

732−-- >>> parseQueryParam "2016-12-31T01:00:00Z" :: Either Text ZonedTime

733−-- Right 2016-12-31 01:00:00 +0000

734−instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime

552+instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z"

735

553

736-- |

554-- |

737-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime

555-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime

738-- Right 2015-10-03 00:14:24 UTC

556-- Right 2015-10-03 00:14:24 UTC

739−instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime

557+instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ"

740

558

741−-- |

742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek

743−-- Right Monday

744−instance FromHttpApiData DayOfWeek where

559+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece

745− parseUrlPiece t = case Map.lookup (T.toLower t) m of

746− Just dow -> Right dow

747− Nothing -> Left $ "Incorrect DayOfWeek: " <> T.take 10 t

748− where

749− m :: Map.Map Text DayOfWeek

750− m = Map.fromList [ (toUrlPiece dow, dow) | dow <- [Monday .. Sunday] ]

751

560

561+instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece

562+instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece

752

563

753−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece

754−

755−-- |

756−-- >>> parseUrlPiece "2021-01" :: Either Text Month

757−-- Right 2021-01

758−instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month

759−

760−-- |

761−-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter

762−-- Right 2021-Q1

763−instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter

764−

765−-- |

766−-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear

767−-- Right Q2

768−--

769−-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear

770−-- Right Q3

771−instance FromHttpApiData QuarterOfYear where

772− parseUrlPiece t = case T.toLower t of

773− "q1" -> return Q1

774− "q2" -> return Q2

775− "q3" -> return Q3

776− "q4" -> return Q4

777− _ -> Left "Invalid quarter of year"

778−

779−instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)

780−instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)

781−

782−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

783−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

564+instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece

784−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

565+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece

785−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))

566+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece

786−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))

787−

788−instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

789−instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

567+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece

790−instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

791−instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

568+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece

792

569

793-- |

570-- |

794-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)

571-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)

@@ -813,7 +590,6 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)

813instance ToHttpApiData UUID.UUID where

590instance ToHttpApiData UUID.UUID where

814 toUrlPiece = UUID.toText

591 toUrlPiece = UUID.toText

815 toHeader = UUID.toASCIIBytes

592 toHeader = UUID.toASCIIBytes

816− toEncodedUrlPiece = unsafeToEncodedUrlPiece

817

593

818instance FromHttpApiData UUID.UUID where

594instance FromHttpApiData UUID.UUID where

819 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText

595 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText

@@ -830,38 +606,3 @@ instance FromHttpApiData a => FromHttpApiData (LenientData a) where

830 parseUrlPiece = Right . LenientData . parseUrlPiece

606 parseUrlPiece = Right . LenientData . parseUrlPiece

831 parseHeader = Right . LenientData . parseHeader

607 parseHeader = Right . LenientData . parseHeader

832 parseQueryParam = Right . LenientData . parseQueryParam

608 parseQueryParam = Right . LenientData . parseQueryParam

833−

834−-- | /Note:/ this instance works correctly for alphanumeric name and value

835−--

836−-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie

837−-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing})

838−instance FromHttpApiData SetCookie where

839− parseUrlPiece = parseHeader . encodeUtf8

840− parseHeader = Right . parseSetCookie

841−

842−-- | Note: this instance is not polykinded

843−instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where

844− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

845− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

846− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)

847−

848−-- | @since 0.4.2

849−instance FromHttpApiData a => FromHttpApiData (Const a b) where

850− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

851− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

852− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)

853−

854−-- | @since 0.4.2

855−instance FromHttpApiData a => FromHttpApiData (Identity a) where

856− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

857− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

858− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)

859−

860−-------------------------------------------------------------------------------

861−-- Attoparsec helpers

862−-------------------------------------------------------------------------------

863−

864−runAtto :: Atto.Parser a -> Text -> Either Text a

865−runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of

866− Left err -> Left (T.pack err)

867− Right x -> Right x

stack-ghc-7.10.yamlnew file+12

@@ -0,0 +1,12 @@

1+resolver: lts-6.8

3+packages:

4+- '.'

6+flags:

7+ http-api-data:

8+ use-text-show: false

10+extra-deps:

11+- QuickCheck-2.9.2

12+extra-package-dbs: []

stack-ghc-7.8.yamlnew file+26

@@ -0,0 +1,26 @@

1+resolver: lts-2.22

3+packages:

4+- '.'

6+flags:

7+ http-api-data:

8+ use-text-show: false

10+extra-deps:

11+- time-locale-compat-0.1.1.3

12+- uri-bytestring-0.2.2.0

13+# below are dependencies necessary for use-text-show=true

14+- text-show-2.1.2

15+- base-compat-0.9.1

16+- bifunctors-5.2

17+- semigroups-0.16.2.2

18+- th-lift-0.7.6

19+- transformers-compat-0.4.0.4

20+- base-orphans-0.5.4

21+- generic-deriving-1.9.0

22+- doctest-0.11.0

23+- QuickCheck-2.9.2

24+- quickcheck-instances-0.3.12

25+- quickcheck-io-0.1.3

26+extra-package-dbs: []

stack.yaml+6−1

@@ -1,6 +1,11 @@

1−resolver: lts-12.10

1+resolver: nightly-2016-12-31

2packages:

3packages:

3- '.'

4- '.'

4flags:

6flags:

5 http-api-data:

7 http-api-data:

6 use-text-show: false

8 use-text-show: false

10+extra-deps: []

11+extra-package-dbs: []

test/DocTest.hscnew file+58

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

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE ForeignFunctionInterface #-}

3+-----------------------------------------------------------------------------

4+-- |

5+-- Module : Main (doctests)

7+-- License : BSD-style (see the file LICENSE)

8+-- Maintainer : Edward Kmett <ekmett@gmail.com>

9+-- Stability : provisional

10+-- Portability : portable

11+--

12+-- This module provides doctests for a project based on the actual versions

13+-- of the packages it was built with. It requires a corresponding Setup.lhs

14+-- to be added to the project

15+-----------------------------------------------------------------------------

16+module Main where

17+

18+import Build_doctests (flags, pkgs, module_sources)

19+#if __GLASGOW_HASKELL__ < 710

20+import Control.Applicative

21+#endif

22+import Data.Foldable (traverse_)

23+import Test.DocTest

24+

25+##if defined(mingw32_HOST_OS)

26+##if defined(i386_HOST_ARCH)

27+##define USE_CP

28+import Control.Applicative

29+import Control.Exception

30+import Foreign.C.Types

31+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool

32+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt

33+##elif defined(x86_64_HOST_ARCH)

34+##define USE_CP

35+import Control.Applicative

36+import Control.Exception

37+import Foreign.C.Types

38+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool

39+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt

40+##endif

41+##endif

42+

43+-- | Run in a modified codepage where we can print UTF-8 values on Windows.

44+withUnicode :: IO a -> IO a

45+##ifdef USE_CP

46+withUnicode m = do

47+ cp <- c_GetConsoleCP

48+ (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp

49+##else

50+withUnicode m = m

51+##endif

52+

53+main :: IO ()

54+main = withUnicode $ do

55+ traverse_ putStrLn args

56+ doctest args

57+ where

58+ args = flags ++ pkgs ++ module_sources

test/Web/Internal/HttpApiDataSpec.hs+51−71

@@ -1,61 +1,40 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE ScopedTypeVariables #-}

2{-# LANGUAGE ScopedTypeVariables #-}

2module Web.Internal.HttpApiDataSpec (spec) where

3module Web.Internal.HttpApiDataSpec (spec) where

5+import Control.Applicative

6+import Data.Int

7+import Data.Word

8+import Data.Time

9+import qualified Data.Text as T

10+import qualified Data.Text.Lazy as L

11+import qualified Data.ByteString as BS

12+import Data.Version

13+import qualified Data.UUID as UUID

5−import Prelude ()

15+import Data.Proxy

6−import Prelude.Compat

8−import qualified Data.ByteString as BS

17+#if MIN_VERSION_base(4,8,0)

9−import Data.ByteString.Builder (toLazyByteString)

18+import Numeric.Natural

10−import Data.Char

19+#endif

11−import qualified Data.Fixed as F

12−import Data.Int

13−import qualified Data.Text as T

14−import qualified Data.Text.Encoding as TE

15−import qualified Data.Text.Lazy as L

16−import Data.Time.Compat

17−import Data.Time.Calendar.Month.Compat (Month)

18−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))

19−import qualified Data.UUID.Types as UUID

20−import Data.Version

21−import Data.Word

22−import Web.Cookie (SetCookie, defaultSetCookie,

23− setCookieName, setCookieValue)

25−import Data.Proxy

21+import Test.Hspec

22+import Test.Hspec.QuickCheck(prop)

23+import Test.QuickCheck

27−import Numeric.Natural

25+import Web.Internal.HttpApiData

29−import Test.Hspec

27+import Web.Internal.TestInstances

30−import Test.Hspec.QuickCheck (prop)

31−import Test.QuickCheck

33−import Web.Internal.HttpApiData

29+(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool

30+(f <=> g) x = g (f x) == Right x

35−import Web.Internal.TestInstances

36−

37−(<=>) :: forall a b. (Show a, Show b, Eq a) => (a -> b) -> (b -> Either T.Text a) -> a -> Property

38−(f <=> g) x = counterexample

39− (show lhs' ++ " : " ++ show lhs ++ " /= " ++ show rhs)

40− (lhs == rhs)

41− where

42− lhs' = f x

43− lhs = g lhs' :: Either T.Text a

44− rhs = Right x :: Either T.Text a

45−

46−encodedUrlPieceProp :: ToHttpApiData a => a -> Property

47−encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x)

48−

49−-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility

50checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec

32checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec

51−checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a)

33+checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)

35+-- | Check with given generator

53checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec

36checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec

54−checkUrlPiece' gen name = describe name $ do

37+checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)

55− prop "toUrlPiece <=> parseUrlPiece" $ forAll gen (toUrlPiece <=> parseUrlPiece :: a -> Property)

56− prop "toQueryParam <=> parseQueryParam" $ forAll gen (toQueryParam <=> parseQueryParam :: a -> Property)

57− prop "toHeader <=> parseHeader" $ forAll gen (toHeader <=> parseHeader :: a -> Property)

58− prop "toEncodedUrlPiece encodes correctly" $ forAll gen encodedUrlPieceProp

60-- | Check case insensitivity for @parseUrlPiece@.

39-- | Check case insensitivity for @parseUrlPiece@.

61checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

40checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

@@ -63,7 +42,7 @@ checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))

64spec :: Spec

43spec :: Spec

65spec = do

44spec = do

66− describe "Instances" $ do

45+ describe "toUrlPiece <=> parseUrlPiece" $ do

67 checkUrlPiece (Proxy :: Proxy ()) "()"

46 checkUrlPiece (Proxy :: Proxy ()) "()"

68 checkUrlPiece (Proxy :: Proxy Char) "Char"

47 checkUrlPiece (Proxy :: Proxy Char) "Char"

69 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"

48 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"

@@ -83,34 +62,21 @@ spec = do

83 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"

62 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"

84 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"

63 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"

85 checkUrlPiece (Proxy :: Proxy Day) "Day"

64 checkUrlPiece (Proxy :: Proxy Day) "Day"

86− checkUrlPiece (Proxy :: Proxy TimeOfDay) "TimeOfDay"

65+ checkUrlPiece' localTimeGen "LocalTime"

87− checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"

88− checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"

66+ checkUrlPiece' zonedTimeGen "ZonedTime"

89− checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"

67+ checkUrlPiece' utcTimeGen "UTCTime"

90− checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"

68+ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"

91− checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"

92− checkUrlPiece (Proxy :: Proxy Quarter) "Quarter"

93− checkUrlPiece (Proxy :: Proxy QuarterOfYear) "QuarterOfYear"

94− checkUrlPiece (Proxy :: Proxy Month) "Month"

95− checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"

96 checkUrlPiece (Proxy :: Proxy Version) "Version"

69 checkUrlPiece (Proxy :: Proxy Version) "Version"

97− checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID"

70+ checkUrlPiece' uuidGen "UUID"

98− checkUrlPiece' setCookieGen "Cookie"

99−

100− checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"

101− checkUrlPiece (Proxy :: Proxy F.Deci) "Deci"

102− checkUrlPiece (Proxy :: Proxy F.Centi) "Centi"

103− checkUrlPiece (Proxy :: Proxy F.Milli) "Milli"

104− checkUrlPiece (Proxy :: Proxy F.Micro) "Micro"

105− checkUrlPiece (Proxy :: Proxy F.Nano) "Nano"

106− checkUrlPiece (Proxy :: Proxy F.Pico) "Pico"

107

108 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

72 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

109 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

73 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

110 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"

74 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"

111 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"

75 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"

112

77+#if MIN_VERSION_base(4,8,0)

113 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

78 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

79+#endif

114

115 it "bad integers are rejected" $ do

81 it "bad integers are rejected" $ do

116 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

82 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

@@ -122,8 +88,22 @@ spec = do

122 it "invalid utf8 is handled" $ do

88 it "invalid utf8 is handled" $ do

123 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)

89 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)

124

125−setCookieGen :: Gen SetCookie

91+uuidGen :: Gen UUID.UUID

126−setCookieGen = do

92+uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

127− n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary

93+

128− v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary

94+-- TODO: this generators don't generate full range items

129− return $ defaultSetCookie { setCookieName = n, setCookieValue = v }

95+localTimeGen :: Gen LocalTime

96+localTimeGen = LocalTime

97+ <$> arbitrary

98+ <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))

99+

100+zonedTimeGen :: Gen ZonedTime

101+zonedTimeGen = ZonedTime

102+ <$> localTimeGen -- Note: not arbitrary!

103+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))

104+

105+utcTimeGen :: Gen UTCTime

106+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))

107+

108+nominalDiffTimeGen :: Gen NominalDiffTime

109+nominalDiffTimeGen = fromInteger <$> arbitrary

test/Web/Internal/TestInstances.hs+1−1

@@ -12,7 +12,7 @@ import Control.Applicative

12import Data.Char

13import qualified Data.HashMap.Strict as HashMap

14import qualified Data.Text as T

15−import Data.Time.Compat

15+import Data.Time

16import GHC.Exts (fromList)

17import GHC.Generics