git.iko.soy/typeable/http-api-data
on 5158283 help sign in
20 files changed+682−932
since splitsnapshots
unifiedsplit
.ghci+1 .github/workflows/haskell-ci.yml−283 .gitignore−1 .travis.yml+109 CHANGELOG.md−80 Setup.hs−2 Setup.lhs+165 cabal.haskell-ci−6 cabal.project−2 http-api-data.cabal+51−60 src/Web/FormUrlEncoded.hs+1−8 src/Web/HttpApiData.hs+3−2 src/Web/Internal/FormUrlEncoded.hs+59−141 src/Web/Internal/HttpApiData.hs+83−276 stack-ghc-7.10.yaml+12 stack-ghc-7.8.yaml+26 stack.yaml+7−1 test/DocTest.hsc+58 test/Web/Internal/HttpApiDataSpec.hs+106−69 test/Web/Internal/TestInstances.hs+1−1
.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 @@
11/dist/
22/dist-newstyle/
3−/.ghc.environment.*
43/.shelly/
54/tarballs/
65*.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
9+
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−80
@@ -1,83 +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−
8110.3.7
822---
833
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+51−60
@@ -1,38 +1,33 @@
1−cabal-version: >= 1.10
21name: http-api-data
3−version: 0.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−
2+version: 0.3.7
123license: BSD3
134license-file: LICENSE
145author: Nickolay Kudasov <nickolay.kudasov@gmail.com>
156maintainer: 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
169homepage: http://github.com/fizruk/http-api-data
10+category: Web
1711stability: unstable
18−build-type: Simple
19−
12+cabal-version: >= 1.10
13+build-type: Custom
2014extra-source-files:
2115 include/overlapping-compat.h
2216 test/*.hs
2317 CHANGELOG.md
2418 README.md
25−
2619tested-with:
20+ GHC==7.8.4,
21+ GHC==7.10.3,
2722 GHC==8.0.2,
28− GHC==8.2.2,
29− GHC==8.4.4,
30− GHC==8.6.5,
31− GHC==8.8.4,
32− GHC==8.10.7,
33− GHC==9.0.2,
34− GHC==9.2.3,
35− GHC==9.4.1
23+ GHC==8.1.*
24+
25+custom-setup
26+ setup-depends:
27+ base >= 4.7 && <4.10,
28+ Cabal >= 1.18 && <1.26,
29+ filepath,
30+ directory
3631
3732flag use-text-show
3833 description: Use text-show library for efficient ToHttpApiData implementations.
@@ -42,31 +37,22 @@ flag use-text-show
4237library
4338 hs-source-dirs: src/
4439 include-dirs: include/
45−
46− -- GHC bundled
47− build-depends: base >= 4.9 && < 4.17
48− , bytestring >= 0.10.8.1 && < 0.12
49− , containers >= 0.5.7.1 && < 0.7
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
60− , http-types >= 0.12.3 && < 0.13
61− , tagged >= 0.8.5 && < 0.9
62− , time-compat >= 1.9.5 && < 1.10
63− , unordered-containers >= 0.2.10.0 && < 0.3
64− , uuid-types >= 1.0.3 && < 1.1
65−
40+ build-depends: base >= 4.7 && < 4.10
41+ , attoparsec >= 0.13.0.1 && < 0.14
42+ , attoparsec-iso8601 >= 1.0.0.0 && < 1.1
43+ , bytestring
44+ , containers
45+ , hashable
46+ , http-types
47+ , text >= 0.5
48+ , time
49+ , time-locale-compat >=0.1.1.0 && <0.2
50+ , unordered-containers
51+ , uri-bytestring
52+ , uuid-types >= 1.0.2 && <1.1
6653 if flag(use-text-show)
6754 cpp-options: -DUSE_TEXT_SHOW
68− build-depends: text-show >= 3.8.2 && <3.10
69−
55+ build-depends: text-show >= 2
7056 exposed-modules:
7157 Web.HttpApiData
7258 Web.FormUrlEncoded
@@ -85,26 +71,31 @@ test-suite spec
8571 hs-source-dirs: test
8672 ghc-options: -Wall
8773 default-language: Haskell2010
88− build-tool-depends: hspec-discover:hspec-discover >= 2.7.1 && <2.11
89− -- inherited depndencies
90− build-depends:
91− base
92− , base-compat
74+ build-depends: HUnit
75+ , hspec >= 1.3
76+ , base >= 4 && < 5
9377 , bytestring
94− , cookie
78+ , QuickCheck >=2.9
79+ , quickcheck-instances >= 0.3.12
80+ , unordered-containers
9581 , http-api-data
9682 , text
97− , time-compat
98− , unordered-containers
99− , uuid-types
100−
101− if !impl(ghc >= 7.10)
102− build-depends: nats
83+ , time
84+ , bytestring
85+ , uuid
10386
104− build-depends: HUnit >= 1.6.0.0 && <1.7
105− , hspec >= 2.7.1 && <2.11
106− , QuickCheck >= 2.13.1 && <2.15
107− , quickcheck-instances >= 0.3.25.2 && <0.4
87+test-suite doctests
88+ ghc-options: -Wall
89+ build-tools: hsc2hs
90+ build-depends:
91+ base,
92+ directory >= 1.0,
93+ doctest >= 0.11 && <0.12,
94+ filepath
95+ default-language: Haskell2010
96+ hs-source-dirs: test
97+ main-is: DocTest.hs
98+ type: exitcode-stdio-1.0
10899
109100source-repository head
110101 type: git
src/Web/FormUrlEncoded.hs+1−8
@@ -14,11 +14,9 @@ module Web.FormUrlEncoded (
1414
1515 -- * Encoding and decoding @'Form'@s
1616 urlEncodeAsForm,
17− urlEncodeAsFormStable,
1817 urlDecodeAsForm,
1918
2019 urlEncodeForm,
21− urlEncodeFormStable,
2220 urlDecodeForm,
2321
2422 -- * 'Generic's
@@ -30,9 +28,7 @@ module Web.FormUrlEncoded (
3028 defaultFormOptions,
3129
3230 -- * Helpers
33− toListStable,
3431 toEntriesByKey,
35− toEntriesByKeyStable,
3632 fromEntriesByKey,
3733
3834 lookupAll,
@@ -42,10 +38,7 @@ module Web.FormUrlEncoded (
4238 parseAll,
4339 parseMaybe,
4440 parseUnique,
45−
46− urlEncodeParams,
47− urlDecodeParams,
4841) where
4942
50−import Web.Internal.FormUrlEncoded
43+import Web.Internal.FormUrlEncoded
5144
src/Web/HttpApiData.hs+3−2
@@ -43,15 +43,16 @@ module Web.HttpApiData (
4343 readTextData,
4444) where
4545
46−import Web.Internal.HttpApiData
46+import Web.Internal.HttpApiData
4747
4848-- $setup
4949--
5050-- >>> :set -XOverloadedStrings
5151-- >>> import Control.Applicative
52−-- >>> import Data.Time.Compat
52+-- >>> import Data.Time
5353-- >>> import Data.Int
5454-- >>> import Data.Text (Text)
55+-- >>> import Data.Time (Day)
5556-- >>> import Data.Version
5657
5758-- $examples
src/Web/Internal/FormUrlEncoded.hs+59−141
@@ -17,51 +17,50 @@
1717#include "overlapping-compat.h"
1818module Web.Internal.FormUrlEncoded where
1919
20−import Prelude ()
21−import Prelude.Compat
20+#if __GLASGOW_HASKELL__ < 710
21+import Control.Applicative
22+import Data.Traversable
23+#endif
24+
2225
23−import Control.Applicative (Const(Const))
2426import Control.Arrow ((***))
2527import Control.Monad ((<=<))
26−import Data.ByteString.Builder (shortByteString, toLazyByteString)
28+import Data.ByteString.Builder (toLazyByteString, shortByteString)
2729import qualified Data.ByteString.Lazy as BSL
2830import qualified Data.ByteString.Lazy.Char8 as BSL8
29−import Data.Coerce (coerce)
3031import qualified Data.Foldable as F
31−import Data.Functor.Identity (Identity(Identity))
3232import Data.Hashable (Hashable)
3333import Data.HashMap.Strict (HashMap)
3434import qualified Data.HashMap.Strict as HashMap
35−import Data.Int (Int16, Int32, Int64, Int8)
35+import Data.Int
3636import Data.IntMap (IntMap)
3737import qualified Data.IntMap as IntMap
38−import Data.List (intersperse, sortBy)
38+import Data.List (intersperse)
3939import Data.Map (Map)
4040import qualified Data.Map as Map
41−import Data.Monoid (All (..), Any (..), Dual (..),
42− Product (..), Sum (..))
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 (..))
41+import Data.Monoid
42+
4843import Data.Text (Text)
4944import qualified Data.Text as Text
50−import qualified Data.Text.Encoding as Text
51−import Data.Text.Encoding.Error (lenientDecode)
5245import qualified Data.Text.Lazy as Lazy
53−import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
54− UTCTime, ZonedTime)
55−import Data.Time.Calendar.Month.Compat (Month)
56−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
57−import Data.Void (Void)
58−import Data.Word (Word16, Word32, Word64, Word8)
59−import GHC.Exts (Constraint, IsList (..))
46+import Data.Text.Encoding as Text
47+import Data.Text.Encoding.Error (lenientDecode)
48+
49+import Data.Time
50+import Data.Proxy
51+import Data.Word
52+
53+#if MIN_VERSION_base(4,8,0)
54+import Data.Void
55+import Numeric.Natural
56+#endif
57+
58+import GHC.Exts (IsList (..), Constraint)
6059import GHC.Generics
6160import GHC.TypeLits
62−import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)
63−import Numeric.Natural (Natural)
64−import Web.Internal.HttpApiData
61+import URI.ByteString (urlEncodeQuery, urlDecodeQuery)
62+
63+import Web.Internal.HttpApiData
6564
6665-- $setup
6766-- >>> :set -XDeriveGeneric
@@ -115,9 +114,6 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam
115114instance ToFormKey ZonedTime where toFormKey = toQueryParam
116115instance ToFormKey UTCTime where toFormKey = toQueryParam
117116instance 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
121117
122118instance ToFormKey String where toFormKey = toQueryParam
123119instance ToFormKey Text where toFormKey = toQueryParam
@@ -126,26 +122,14 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam
126122instance ToFormKey All where toFormKey = toQueryParam
127123instance ToFormKey Any where toFormKey = toQueryParam
128124
129−instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)
130−instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)
131−instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text)
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)
125+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual
126+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
127+instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
146128
129+#if MIN_VERSION_base(4,8,0)
147130instance ToFormKey Void where toFormKey = toQueryParam
148131instance ToFormKey Natural where toFormKey = toQueryParam
132+#endif
149133
150134-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
151135class FromFormKey k where
@@ -177,9 +161,6 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam
177161instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
178162instance FromFormKey UTCTime where parseFormKey = parseQueryParam
179163instance 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
183164
184165instance FromFormKey String where parseFormKey = parseQueryParam
185166instance FromFormKey Text where parseFormKey = parseQueryParam
@@ -188,48 +169,30 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam
188169instance FromFormKey All where parseFormKey = parseQueryParam
189170instance FromFormKey Any where parseFormKey = parseQueryParam
190171
191−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
192−instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
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)
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)
172+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey
173+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
174+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
208175
176+#if MIN_VERSION_base(4,8,0)
209177instance FromFormKey Void where parseFormKey = parseQueryParam
210178instance FromFormKey Natural where parseFormKey = parseQueryParam
179+#endif
211180
212181-- | The contents of a form, not yet URL-encoded.
213182--
214183-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
215184newtype Form = Form { unForm :: HashMap Text [Text] }
216− deriving (Eq, Read, Generic, Semigroup, Monoid)
185+ deriving (Eq, Read, Generic, Monoid)
217186
218187instance Show Form where
219188 showsPrec d form = showParen (d > 10) $
220− showString "fromList " . shows (toListStable form)
189+ showString "fromList " . shows (toList form)
221190
222−-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
223−-- For a stable conversion use 'toListStable'.
224191instance IsList Form where
225192 type Item Form = (Text, Text)
226193 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
227194 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
228195
229−-- | A stable version of 'toList'.
230−toListStable :: Form -> [(Text, Text)]
231−toListStable = sortOn fst . toList
232−
233196-- | Convert a value into 'Form'.
234197--
235198-- An example type and instance:
@@ -340,7 +303,7 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint
340303-- instance 'ToForm' Post
341304-- @
342305--
343−-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
306+-- >>> urlEncodeAsForm Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
344307-- "comments=Nice%20post%21&comments=%2B1&title=Test"
345308genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
346309genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
@@ -425,7 +388,6 @@ class FromForm a where
425388
426389instance FromForm Form where fromForm = pure
427390
428−-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
429391instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
430392 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
431393
@@ -440,22 +402,13 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where
440402
441403-- | Parse a 'Form' into a list of entries groupped by key.
442404--
443−-- _NOTE:_ this conversion is unstable and may result in different key order
444−-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
405+-- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
406+-- Right [("color",["red","white"]),("name",["Nick"])]
445407toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
446408toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
447409 where
448410 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
449411
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−
459412-- | A 'Generic'-based implementation of 'fromForm'.
460413-- This is used as a default implementation in 'FromForm'.
461414--
@@ -529,53 +482,39 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where
529482
530483-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
531484--
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−--
541485-- Key-value pairs get encoded to @key=value@ and separated by @&@:
542486--
543−-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
487+-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]
544488-- "lastname=Arni&name=Julian"
545489--
546490-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
547491--
548−-- >>> urlEncodeFormStable [("is_test", "")]
492+-- >>> urlEncodeForm [("is_test", "")]
549493-- "is_test"
550494--
551495-- Empty keys are allowed too:
552496--
553−-- >>> urlEncodeFormStable [("", "foobar")]
497+-- >>> urlEncodeForm [("", "foobar")]
554498-- "=foobar"
555499--
556−-- However, if both key and value are empty, the key-value pair is ignored.
557−-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
500+-- However, if not key and value are empty, the key-value pair is ignored.
501+-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).
558502--
559−-- >>> urlEncodeFormStable [("", "")]
503+-- >>> urlEncodeForm [("", "")]
560504-- ""
561505--
562506-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
563507--
564−-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
508+-- >>> urlEncodeForm [("fullname", "Andres Löh")]
565509-- "fullname=Andres%20L%C3%B6h"
566−urlEncodeFormStable :: 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
510+urlEncodeForm :: Form -> BSL.ByteString
511+urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList
574512 where
575− escape = urlEncodeBuilder True . Text.encodeUtf8
513+ escape = urlEncodeQuery . Text.encodeUtf8
576514
577515 encodePair (k, "") = escape k
578− encodePair (k, v) = escape k <> shortByteString "=" <> escape v
516+ encodePair (k, v) = escape k <> shortByteString "=" <> escape v
517+
579518
580519-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
581520--
@@ -609,17 +548,11 @@ urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&")
609548-- >>> urlDecodeForm "this=has=too=many=equals"
610549-- Left "not a valid pair: this=has=too=many=equals"
611550urlDecodeForm :: 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
619552 where
620553 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
621554
622− unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict
555+ unescape = Text.decodeUtf8With lenientDecode . urlDecodeQuery . BSL.toStrict
623556
624557 parsePair p =
625558 case map unescape p of
@@ -627,7 +560,6 @@ urlDecodeParams bs = traverse parsePair pairs
627560 [k] -> return (k, "")
628561 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
629562
630−
631563-- | This is a convenience function for decoding a
632564-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
633565-- that has an instance of 'FromForm'.
@@ -645,22 +577,11 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm
645577--
646578-- This is effectively @'urlEncodeForm' . 'toForm'@.
647579--
648−-- _NOTE:_ this encoding is unstable and may result in different key order
649−-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
580+-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}
581+-- "age=22&name=Dennis"
650582urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
651583urlEncodeAsForm = urlEncodeForm . toForm
652584
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−
664585-- | Find all values corresponding to a given key in a 'Form'.
665586--
666587-- >>> lookupAll "name" []
@@ -771,8 +692,8 @@ parseUnique key form = lookupUnique key form >>= parseQueryParam
771692-- 'fromForm' = 'genericFromForm' myOptions
772693-- @
773694--
774−-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }
775−-- "name=http-api-data&size=172"
695+-- >>> urlEncodeAsForm Project { projectName = "http-api-data", projectSize = 172 }
696+-- "size=172&name=http-api-data"
776697-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
777698-- Right (Project {projectName = "http-api-data", projectSize = 172})
778699data FormOptions = FormOptions
@@ -791,6 +712,3 @@ defaultFormOptions :: FormOptions
791712defaultFormOptions = FormOptions
792713 { fieldLabelModifier = id
793714 }
794−
795−sortOn :: Ord b => (a -> b) -> [a] -> [a]
796−sortOn f = sortBy (comparing f)
src/Web/Internal/HttpApiData.hs+83−276
@@ -1,86 +1,70 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFoldable #-}
5−{-# LANGUAGE DeriveFunctor #-}
6−{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE KindSignatures #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFunctor #-}
5+{-# LANGUAGE DeriveFoldable #-}
6+{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
1210{-# LANGUAGE TypeSynonymInstances #-}
1311-- |
1412-- Convert Haskell values to and from HTTP API data
1513-- such as URL pieces, headers and query parameters.
1614module Web.Internal.HttpApiData where
1715
18−import Prelude ()
19−import Prelude.Compat
20−
21−import Control.Applicative (Const(Const))
22−import Control.Arrow (left, (&&&))
23−import Control.Monad ((<=<))
24−import qualified Data.Attoparsec.Text as Atto
25−import qualified Data.Attoparsec.Time as Atto
26−import Data.ByteString (ByteString)
27−import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Builder as BS
29−import qualified Data.ByteString.Lazy as LBS
30−import Data.Coerce (coerce)
31−import Data.Data (Data)
32−import qualified Data.Fixed as F
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
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,
50− signed)
51−import Data.Time.Compat (Day, FormatTime, LocalTime,
52− NominalDiffTime, TimeOfDay,
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)
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
61− toYearQuarter)
62−import Data.Typeable (Typeable)
63−import qualified Data.UUID.Types as UUID
64−import Data.Version (Version, parseVersion,
65− showVersion)
66−import Data.Void (Void, absurd)
67−import Data.Word (Word16, Word32, Word64, Word8)
68−import qualified Network.HTTP.Types as H
69−import Numeric.Natural (Natural)
70−import Text.ParserCombinators.ReadP (readP_to_S)
71−import Text.Read (readMaybe)
72−import Web.Cookie (SetCookie, parseSetCookie,
73− renderSetCookie)
16+#if __GLASGOW_HASKELL__ < 710
17+import Control.Applicative
18+import Data.Foldable (Foldable)
19+import Data.Traversable (Traversable(traverse))
20+#endif
21+
22+import Control.Arrow ((&&&), left)
23+import Control.Monad ((<=<))
24+
25+import Data.Monoid
26+import Data.ByteString (ByteString)
27+import qualified Data.ByteString as BS
28+
29+import Data.Int
30+import Data.Word
31+
32+import Data.Text (Text)
33+import Data.Text.Encoding (encodeUtf8, decodeUtf8')
34+import Data.Text.Read (signed, decimal, rational, Reader)
35+import qualified Data.Text as T
36+import qualified Data.Text.Lazy as L
37+
38+import Data.Time.Locale.Compat
39+import Data.Time
40+import Data.Version
41+
42+#if MIN_VERSION_base(4,8,0)
43+import Data.Void
44+import Numeric.Natural
45+#endif
46+
47+import Text.Read (readMaybe)
48+import Text.ParserCombinators.ReadP (readP_to_S)
7449
7550#if USE_TEXT_SHOW
76−import TextShow (TextShow, showt)
51+import TextShow (TextShow, showt)
7752#endif
7853
54+import qualified Data.UUID.Types as UUID
55+
56+import Data.Typeable (Typeable)
57+import Data.Data (Data)
58+import qualified Data.ByteString.Builder as BS
59+import qualified Network.HTTP.Types as H
60+
61+import qualified Data.Attoparsec.Text as Atto
62+import qualified Data.Attoparsec.Time as Atto
63+
64+
7965-- $setup
8066-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
8167-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
82−-- >>> import Data.Time.Compat
83−-- >>> import Data.Version
8468
8569-- | Convert value to HTTP API data.
8670--
@@ -96,7 +80,7 @@ class ToHttpApiData a where
9680 -- The default definition uses 'H.encodePathSegmentsRelative',
9781 -- but this may be overriden with a more efficient version.
9882 toEncodedUrlPiece :: a -> BS.Builder
99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
83+ toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece
10084
10185 -- | Convert to HTTP header value.
10286 toHeader :: a -> ByteString
@@ -338,7 +322,7 @@ lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
338322-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
339323-- Right True
340324--
341−-- For case insensitive parser see 'parseBoundedEnumOfI'.
325+-- For case sensitive parser see 'parseBoundedEnumOfI'.
342326parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
343327parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
344328
@@ -383,7 +367,7 @@ parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of
383367-- Right 1991-06-02
384368--
385369-- This parser is case sensitive and will not match @'showTextData'@
386−-- in presence of letters:
370+-- in presense of letters:
387371--
388372-- >>> readTextData (showTextData True) :: Either Text Bool
389373-- Left "could not parse: `true'"
@@ -439,8 +423,10 @@ instance ToHttpApiData Version where
439423 toUrlPiece = T.pack . showVersion
440424 toEncodedUrlPiece = unsafeToEncodedUrlPiece
441425
426+#if MIN_VERSION_base(4,8,0)
442427instance ToHttpApiData Void where toUrlPiece = absurd
443428instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
429+#endif
444430
445431instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
446432instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
@@ -459,9 +445,6 @@ instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = un
459445instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
460446instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
461447
462−-- | Note: this instance is not polykinded
463−instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
464−
465448-- |
466449-- >>> toUrlPiece (fromGregorian 2015 10 03)
467450-- "2015-10-03"
@@ -500,108 +483,36 @@ instance ToHttpApiData UTCTime where
500483 toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
501484 toEncodedUrlPiece = unsafeToEncodedUrlPiece
502485
503−-- |
504−-- >>> toUrlPiece Monday
505−-- "monday"
506−instance ToHttpApiData DayOfWeek where
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−
543−-- |
544−-- >>> import Data.Time.Calendar.Month.Compat (Month (..))
545−-- >>> MkMonth 24482
546−-- 2040-03
547−--
548−-- >>> toUrlPiece $ MkMonth 24482
549−-- "2040-03"
550−--
551−instance ToHttpApiData Month where
552− toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"
553−
554486instance ToHttpApiData NominalDiffTime where
555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
487+ toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
556488 toEncodedUrlPiece = unsafeToEncodedUrlPiece
557489
558490instance ToHttpApiData String where toUrlPiece = T.pack
559491instance ToHttpApiData Text where toUrlPiece = id
560492instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
561493
562−instance ToHttpApiData All where
563− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
564− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
565−
566−instance ToHttpApiData Any where
567− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
568− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
494+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll
495+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny
569496
570497instance ToHttpApiData a => ToHttpApiData (Dual a) where
571− toUrlPiece = coerce (toUrlPiece :: a -> Text)
572− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
498+ toUrlPiece = toUrlPiece . getDual
499+ toEncodedUrlPiece = toEncodedUrlPiece . getDual
573500
574501instance ToHttpApiData a => ToHttpApiData (Sum a) where
575− toUrlPiece = coerce (toUrlPiece :: a -> Text)
576− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
502+ toUrlPiece = toUrlPiece . getSum
503+ toEncodedUrlPiece = toEncodedUrlPiece . getSum
577504
578505instance ToHttpApiData a => ToHttpApiData (Product a) where
579− toUrlPiece = coerce (toUrlPiece :: a -> Text)
580− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
506+ toUrlPiece = toUrlPiece . getProduct
507+ toEncodedUrlPiece = toEncodedUrlPiece . getProduct
581508
582509instance ToHttpApiData a => ToHttpApiData (First a) where
583− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
584− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
510+ toUrlPiece = toUrlPiece . getFirst
511+ toEncodedUrlPiece = toEncodedUrlPiece . getFirst
585512
586513instance 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
591− toUrlPiece = coerce (toUrlPiece :: a -> Text)
592− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
593−
594−instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where
595− toUrlPiece = coerce (toUrlPiece :: a -> Text)
596− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
597−
598−instance ToHttpApiData a => ToHttpApiData (Semi.First a) where
599− toUrlPiece = coerce (toUrlPiece :: a -> Text)
600− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
601−
602−instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where
603− toUrlPiece = coerce (toUrlPiece :: a -> Text)
604− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
514+ toUrlPiece = toUrlPiece . getLast
515+ toEncodedUrlPiece = toEncodedUrlPiece . getLast
605516
606517-- |
607518-- >>> toUrlPiece (Just "Hello")
@@ -619,41 +530,6 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
619530 toUrlPiece (Left x) = "left " <> toUrlPiece x
620531 toUrlPiece (Right x) = "right " <> toUrlPiece x
621532
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−
657533-- |
658534-- >>> parseUrlPiece "_" :: Either Text ()
659535-- Right ()
@@ -665,7 +541,7 @@ instance FromHttpApiData Char where
665541 parseUrlPiece s =
666542 case T.uncons s of
667543 Just (c, s') | T.null s' -> pure c
668− _ -> defaultParseError s
544+ _ -> defaultParseError s
669545
670546-- |
671547-- >>> showVersion <$> parseUrlPiece "1.2.3"
@@ -676,6 +552,7 @@ instance FromHttpApiData Version where
676552 ((x, ""):_) -> pure x
677553 _ -> defaultParseError s
678554
555+#if MIN_VERSION_base(4,8,0)
679556-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
680557instance FromHttpApiData Void where
681558 parseUrlPiece _ = Left "Void cannot be parsed!"
@@ -686,6 +563,7 @@ instance FromHttpApiData Natural where
686563 if n < 0
687564 then Left ("underflow: " <> s <> " (should be a non-negative integer)")
688565 else Right (fromInteger n)
566+#endif
689567
690568instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
691569instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
@@ -706,10 +584,6 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706584instance FromHttpApiData Text where parseUrlPiece = Right
707585instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
708586
709−-- | Note: this instance is not polykinded
710−instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where
711− parseUrlPiece = runReader rational
712−
713587-- |
714588-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
715589-- Right (2016,12,1)
@@ -738,57 +612,16 @@ instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
738612-- Right 2015-10-03 00:14:24 UTC
739613instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
740614
741−-- |
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
743−-- Right Monday
744−instance FromHttpApiData DayOfWeek where
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−
615+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece
752616
753−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
617+instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
618+instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
754619
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)
784−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
785−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
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)
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)
620+instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
621+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
622+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
623+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
624+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
792625
793626-- |
794627-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
@@ -831,32 +664,6 @@ instance FromHttpApiData a => FromHttpApiData (LenientData a) where
831664 parseHeader = Right . LenientData . parseHeader
832665 parseQueryParam = Right . LenientData . parseQueryParam
833666
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−
860667-------------------------------------------------------------------------------
861668-- Attoparsec helpers
862669-------------------------------------------------------------------------------
stack-ghc-7.10.yamlnew file+12
@@ -0,0 +1,12 @@
1+resolver: lts-6.8
2+
3+packages:
4+- '.'
5+
6+flags:
7+ http-api-data:
8+ use-text-show: false
9+
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
2+
3+packages:
4+- '.'
5+
6+flags:
7+ http-api-data:
8+ use-text-show: false
9+
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+7−1
@@ -1,6 +1,12 @@
1−resolver: lts-12.10
1+resolver: nightly-2017-04-01
2+
23packages:
34- '.'
5+
46flags:
57 http-api-data:
68 use-text-show: false
9+
10+extra-deps:
11+- attoparsec-iso8601-1.0.0.0
12+extra-package-dbs: []
test/DocTest.hscnew file+58
@@ -0,0 +1,58 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ForeignFunctionInterface #-}
3+-----------------------------------------------------------------------------
4+-- |
5+-- Module : Main (doctests)
6+-- Copyright : (C) 2012-14 Edward Kmett
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+106−69
@@ -1,69 +1,62 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE ScopedTypeVariables #-}
23module Web.Internal.HttpApiDataSpec (spec) where
34
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.ByteString.Builder (toLazyByteString)
13+import Data.Version
14+import qualified Data.UUID as UUID
415
5−import Prelude ()
6−import Prelude.Compat
16+import Data.Proxy
717
8−import qualified Data.ByteString as BS
9−import Data.ByteString.Builder (toLazyByteString)
10−import Data.Char
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)
18+#if MIN_VERSION_base(4,8,0)
19+import Numeric.Natural
20+#endif
2421
25−import Data.Proxy
22+import Test.Hspec
23+import Test.Hspec.QuickCheck(prop)
24+import Test.QuickCheck
2625
27−import Numeric.Natural
26+import Web.Internal.HttpApiData
2827
29−import Test.Hspec
30−import Test.Hspec.QuickCheck (prop)
31−import Test.QuickCheck
28+import Web.Internal.TestInstances
3229
33−import Web.Internal.HttpApiData
30+(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
31+(f <=> g) x = g (f x) == Right x
3432
35−import Web.Internal.TestInstances
33+encodedUrlPieceProp :: ToHttpApiData a => a -> Bool
34+encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) == toLazyByteString (toEncodedUrlPiece x)
3635
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
4536
46−encodedUrlPieceProp :: ToHttpApiData a => a -> Property
47−encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x)
48−
49−-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility
5037checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
51−checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a)
38+checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
5239
40+-- | Check with given generator
5341checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec
54−checkUrlPiece' gen name = describe name $ do
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
42+checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)
5943
6044-- | Check case insensitivity for @parseUrlPiece@.
6145checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
6246checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
6347
48+-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.
49+checkEncodedUrlPiece :: forall a. (Show a, ToHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
50+checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a)
51+
52+-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.
53+-- Use a given generator.
54+checkEncodedUrlPiece' :: forall a. (Show a, ToHttpApiData a) => Gen a -> String -> Spec
55+checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp
56+
6457spec :: Spec
6558spec = do
66− describe "Instances" $ do
59+ describe "toUrlPiece <=> parseUrlPiece" $ do
6760 checkUrlPiece (Proxy :: Proxy ()) "()"
6861 checkUrlPiece (Proxy :: Proxy Char) "Char"
6962 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
@@ -83,34 +76,59 @@ spec = do
8376 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
8477 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
8578 checkUrlPiece (Proxy :: Proxy Day) "Day"
86− checkUrlPiece (Proxy :: Proxy TimeOfDay) "TimeOfDay"
87− checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"
88− checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"
89− checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
90− checkUrlPiece (Proxy :: Proxy NominalDiffTime) "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"
79+ checkUrlPiece' timeOfDayGen "TimeOfDay"
80+ checkUrlPiece' localTimeGen "LocalTime"
81+ checkUrlPiece' zonedTimeGen "ZonedTime"
82+ checkUrlPiece' utcTimeGen "UTCTime"
83+ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"
9684 checkUrlPiece (Proxy :: Proxy Version) "Version"
97− checkUrlPiece (Proxy :: Proxy UUID.UUID) "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"
85+ checkUrlPiece' uuidGen "UUID"
10786
10887 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
10988 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
11089 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
11190 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
11291
92+#if MIN_VERSION_base(4,8,0)
11393 checkUrlPiece (Proxy :: Proxy Natural) "Natural"
94+#endif
95+
96+ describe "toEncodedUrlPiece encodes correctly" $ do
97+ checkEncodedUrlPiece (Proxy :: Proxy ()) "()"
98+ checkEncodedUrlPiece (Proxy :: Proxy Char) "Char"
99+ checkEncodedUrlPiece (Proxy :: Proxy Bool) "Bool"
100+ checkEncodedUrlPiece (Proxy :: Proxy Ordering) "Ordering"
101+ checkEncodedUrlPiece (Proxy :: Proxy Int) "Int"
102+ checkEncodedUrlPiece (Proxy :: Proxy Int8) "Int8"
103+ checkEncodedUrlPiece (Proxy :: Proxy Int16) "Int16"
104+ checkEncodedUrlPiece (Proxy :: Proxy Int32) "Int32"
105+ checkEncodedUrlPiece (Proxy :: Proxy Int64) "Int64"
106+ checkEncodedUrlPiece (Proxy :: Proxy Integer) "Integer"
107+ checkEncodedUrlPiece (Proxy :: Proxy Word) "Word"
108+ checkEncodedUrlPiece (Proxy :: Proxy Word8) "Word8"
109+ checkEncodedUrlPiece (Proxy :: Proxy Word16) "Word16"
110+ checkEncodedUrlPiece (Proxy :: Proxy Word32) "Word32"
111+ checkEncodedUrlPiece (Proxy :: Proxy Word64) "Word64"
112+ checkEncodedUrlPiece (Proxy :: Proxy String) "String"
113+ checkEncodedUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
114+ checkEncodedUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
115+ checkEncodedUrlPiece (Proxy :: Proxy Day) "Day"
116+ checkEncodedUrlPiece' timeOfDayGen "TimeOfDay"
117+ checkEncodedUrlPiece' localTimeGen "LocalTime"
118+ checkEncodedUrlPiece' zonedTimeGen "ZonedTime"
119+ checkEncodedUrlPiece' utcTimeGen "UTCTime"
120+ checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"
121+ checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"
122+ checkEncodedUrlPiece' uuidGen "UUID"
123+
124+ checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
125+ checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
126+ checkEncodedUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
127+ checkEncodedUrlPiece (Proxy :: Proxy (Either Version Day)) "Either Version Day"
128+
129+#if MIN_VERSION_base(4,8,0)
130+ checkEncodedUrlPiece (Proxy :: Proxy Natural) "Natural"
131+#endif
114132
115133 it "bad integers are rejected" $ do
116134 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
@@ -122,8 +140,27 @@ spec = do
122140 it "invalid utf8 is handled" $ do
123141 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
124142
125−setCookieGen :: Gen SetCookie
126−setCookieGen = do
127− n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary
128− v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary
129− return $ defaultSetCookie { setCookieName = n, setCookieValue = v }
143+
144+uuidGen :: Gen UUID.UUID
145+uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
146+
147+-- TODO: this generators don't generate full range items
148+localTimeGen :: Gen LocalTime
149+localTimeGen = LocalTime <$> arbitrary <*> timeOfDayGen
150+
151+timeOfDayGen :: Gen TimeOfDay
152+timeOfDayGen = TimeOfDay
153+ <$> choose (0, 23)
154+ <*> choose (0, 59)
155+ <*> fmap (\x -> 0.1 * fromInteger x) (choose (0, 600))
156+
157+zonedTimeGen :: Gen ZonedTime
158+zonedTimeGen = ZonedTime
159+ <$> localTimeGen -- Note: not arbitrary!
160+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
161+
162+utcTimeGen :: Gen UTCTime
163+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
164+
165+nominalDiffTimeGen :: Gen NominalDiffTime
166+nominalDiffTimeGen = fromInteger <$> arbitrary
test/Web/Internal/TestInstances.hs+1−1
@@ -12,7 +12,7 @@ import Control.Applicative
1212import Data.Char
1313import qualified Data.HashMap.Strict as HashMap
1414import qualified Data.Text as T
15−import Data.Time.Compat
15+import Data.Time
1616import GHC.Exts (fromList)
1717import GHC.Generics
1818