git.iko.soy/typeable/http-api-data
on 992c18a help sign in
20 files changed+560−915
since splitsnapshots
unifiedsplit
.ghci+1 .github/workflows/haskell-ci.yml−283 .travis.yml+114 CHANGELOG.md−75 Setup.hs−2 Setup.lhs+36 cabal.haskell-ci−6 cabal.make-travis-yml+38 cabal.project−2 http-api-data.cabal+52−59 src/Web/FormUrlEncoded.hs+1−8 src/Web/HttpApiData.hs+3−2 src/Web/Internal/FormUrlEncoded.hs+59−141 src/Web/Internal/HttpApiData.hs+82−275 stack-ghc-7.10.yaml+12 stack-ghc-7.8.yaml+26 stack.yaml+7−1 test/Web/Internal/HttpApiDataSpec.hs+103−60 test/Web/Internal/TestInstances.hs+1−1 test/doctests.hs+25
.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
.travis.ymlnew file+114
@@ -0,0 +1,114 @@
1+# This Travis job script has been generated by a script via
2+#
3+# runghc make_travis_yml_2.hs '--config' '--output' '.travis.yml' '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+branches:
14+ only:
15+ - master
16+
17+cache:
18+ directories:
19+ - $HOME/.cabal/packages
20+ - $HOME/.cabal/store
21+
22+before_cache:
23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
24+ # remove files that are regenerated by 'cabal update'
25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
27+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
28+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
29+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
30+
31+ - rm -fv $HOME/.cabal/packages/head.hackage
32+
33+matrix:
34+ include:
35+ - compiler: "ghc-7.8.4"
36+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}
38+ - compiler: "ghc-7.10.3"
39+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
40+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
41+ - compiler: "ghc-8.0.2"
42+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
43+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
44+ - compiler: "ghc-8.2.2"
45+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
46+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
47+
48+before_install:
49+ - HC=${CC}
50+ - HCPKG=${HC/ghc/ghc-pkg}
51+ - unset CC
52+ - ROOTDIR=$(pwd)
53+ - mkdir -p $HOME/.local/bin
54+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"
55+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
56+ - echo $HCNUMVER
57+
58+install:
59+ - cabal --version
60+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
61+ - BENCH=${BENCH---enable-benchmarks}
62+ - TEST=${TEST---enable-tests}
63+ - HADDOCK=${HADDOCK-true}
64+ - INSTALLED=${INSTALLED-true}
65+ - GHCHEAD=${GHCHEAD-false}
66+ - travis_retry cabal update -v
67+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
68+ - rm -fv cabal.project cabal.project.local
69+ - "if [ $HCNUMVER -ge 70800 ]; then sed -i.bak 's/-- ghc-options:.*/ghc-options: -j2/' ${HOME}/.cabal/config; fi"
70+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
71+ - "printf 'packages: \".\"\\n' > cabal.project"
72+ - cat cabal.project
73+ - if [ -f "./configure.ac" ]; then
74+ (cd "." && autoreconf -i);
75+ fi
76+ - rm -f cabal.project.freeze
77+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
78+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
79+ - rm -rf "."/.ghc.environment.* "."/dist
80+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
81+
82+# Here starts the actual work to be performed for the package under test;
83+# any command which exits with a non-zero exit code causes the build to fail.
84+script:
85+ # test that source-distributions can be generated
86+ - (cd "." && cabal sdist)
87+ - mv "."/dist/http-api-data-*.tar.gz ${DISTDIR}/
88+ - cd ${DISTDIR} || false
89+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
90+ - "printf 'packages: http-api-data-*/*.cabal\\n' > cabal.project"
91+ - cat cabal.project
92+ # this builds all libraries and executables (without tests/benchmarks)
93+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
94+
95+ # Build with installed constraints for packages in global-db
96+ - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi
97+
98+ # build & run tests, build benchmarks
99+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all
100+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
101+
102+ # cabal check
103+ - (cd http-api-data-* && cabal check)
104+
105+ # haddock
106+ - rm -rf ./dist-newstyle
107+ - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
108+
109+ - if [ $HCNUMVER -eq 70804 ]; then cabal new-build -w ${HC} --disable-tests --disable-benchmarks --constraint='attoparsec ==0.13.0.1' --constraint='attoparsec-iso8601 ==1.0.0.0' --constraint='bytestring ==0.10.4.0' --constraint='containers ==0.5.5.1' --constraint='hashable ==1.1.2.4' --constraint='http-types ==0.8.6' --constraint='text ==1.1.1.3' --constraint='time ==1.4.2' --constraint='time-local-compat ==0.1.1.0' --constraint='unordered-containers ==0.2.5.0' --constraint='uri-bytestring ==0.1.7' --constraint='uuid-types ==1.0.2' all; else echo skipping...; fi
110+
111+ - if [ $HCNUMVER -eq 71003 ]; then cabal new-build -w ${HC} --disable-tests --disable-benchmarks --constraint='attoparsec ==0.13.0.1' --constraint='attoparsec-iso8601 ==1.0.0.0' --constraint='bytestring ==0.10.6.0' --constraint='containers ==0.5.6.1' --constraint='hashable ==1.2.3.2' --constraint='http-types ==0.8.6' --constraint='text ==1.2.0.2' --constraint='time ==1.5.0.1' --constraint='time-local-compat ==0.1.1.0' --constraint='unordered-containers ==0.2.5.1' --constraint='uri-bytestring ==0.1.7' --constraint='uuid-types ==1.0.2' all; else echo skipping...; fi
112+
113+# REGENDATA ["--config","--output",".travis.yml","http-api-data.cabal"]
114+# EOF
CHANGELOG.md−75
@@ -1,78 +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−
7610.3.7.1
772---
783
Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
Setup.lhsnew file+36
@@ -0,0 +1,36 @@
1+\begin{code}
2+{-# LANGUAGE CPP #-}
3+{-# OPTIONS_GHC -Wall #-}
4+module Main (main) where
5+
6+#ifndef MIN_VERSION_cabal_doctest
7+#define MIN_VERSION_cabal_doctest(x,y,z) 0
8+#endif
9+
10+#if MIN_VERSION_cabal_doctest(1,0,0)
11+
12+import Distribution.Extra.Doctest ( defaultMainWithDoctests )
13+main :: IO ()
14+main = defaultMainWithDoctests "doctests"
15+
16+#else
17+
18+#ifdef MIN_VERSION_Cabal
19+-- If the macro is defined, we have new cabal-install,
20+-- but for some reason we don't have cabal-doctest in package-db
21+--
22+-- Probably we are running cabal sdist, when otherwise using new-build
23+-- workflow
24+#warning You are configuring this package without cabal-doctest installed. \
25+ The doctests test-suite will not work as a result. \
26+ To fix this, install cabal-doctest before configuring.
27+#endif
28+
29+import Distribution.Simple
30+
31+main :: IO ()
32+main = defaultMain
33+
34+#endif
35+
36+\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.make-travis-ymlnew file+38
@@ -0,0 +1,38 @@
1+jobs: :2
2+branches: master
3+
4+-- we use http-types ==0.8.6
5+-- because build plan has blaze-builder-0.4
6+--
7+-- strict lower-bound for http-types ==0.8.3,
8+constraint-set lower-bounds-7.8.4
9+ ghc: == 7.8.4
10+ constraints:
11+ attoparsec ==0.13.0.1,
12+ attoparsec-iso8601 ==1.0.0.0,
13+ bytestring ==0.10.4.0,
14+ containers ==0.5.5.1,
15+ hashable ==1.1.2.4,
16+ http-types ==0.8.6,
17+ text ==1.1.1.3,
18+ time ==1.4.2,
19+ time-local-compat ==0.1.1.0,
20+ unordered-containers ==0.2.5.0,
21+ uri-bytestring ==0.1.7,
22+ uuid-types ==1.0.2
23+
24+constraint-set lower-bounds-7.10.3
25+ ghc: == 7.10.3
26+ constraints:
27+ attoparsec ==0.13.0.1,
28+ attoparsec-iso8601 ==1.0.0.0,
29+ bytestring ==0.10.6.0,
30+ containers ==0.5.6.1,
31+ hashable ==1.2.3.2,
32+ http-types ==0.8.6,
33+ text ==1.2.0.2,
34+ time ==1.5.0.1,
35+ time-local-compat ==0.1.1.0,
36+ unordered-containers ==0.2.5.1,
37+ uri-bytestring ==0.1.7,
38+ uuid-types ==1.0.2
cabal.projectdeleted−2
@@ -1,2 +0,0 @@
1−packages: .
2−tests: True
http-api-data.cabal+52−59
@@ -1,38 +1,35 @@
1−cabal-version: >= 1.10
21name: http-api-data
3−version: 0.5
4−
2+version: 0.3.7.1
3+license: BSD3
4+license-file: LICENSE
5+author: Nickolay Kudasov <nickolay.kudasov@gmail.com>
6+maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>
57synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.
6−category: Web
78description:
89 This package defines typeclasses used for converting Haskell data types to and from HTTP API data.
910 .
1011 Please see README.md
11−
12−license: BSD3
13−license-file: LICENSE
14−author: Nickolay Kudasov <nickolay.kudasov@gmail.com>
15−maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>
1612homepage: http://github.com/fizruk/http-api-data
13+category: Web
1714stability: unstable
18−build-type: Simple
19−
15+cabal-version: >= 1.10
16+build-type: Custom
2017extra-source-files:
2118 include/overlapping-compat.h
2219 test/*.hs
2320 CHANGELOG.md
2421 README.md
25−
2622tested-with:
23+ GHC==7.8.4,
24+ GHC==7.10.3,
2725 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
26+ GHC==8.2.2
27+
28+custom-setup
29+ setup-depends:
30+ base >= 4.7 && <4.11,
31+ Cabal >= 1.18 && <2.1,
32+ cabal-doctest >=1.0.1 && <1.1
3633
3734flag use-text-show
3835 description: Use text-show library for efficient ToHttpApiData implementations.
@@ -42,31 +39,22 @@ flag use-text-show
4239library
4340 hs-source-dirs: src/
4441 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−
42+ build-depends: base >= 4.7 && < 4.11
43+ , attoparsec >= 0.13.0.1 && < 0.14
44+ , attoparsec-iso8601 >= 1.0.0.0 && < 1.1
45+ , bytestring >= 0.10.4.0 && < 0.11
46+ , containers >= 0.5.5.1 && < 0.6
47+ , hashable >= 1.1.2.4 && < 1.3
48+ , http-types >= 0.8.6 && < 0.12
49+ , text >= 1.1.1.3 && < 1.3
50+ , time >= 1.4.2 && < 1.9
51+ , time-locale-compat >= 0.1.1.0 && < 0.2
52+ , unordered-containers >= 0.2.5.0 && < 0.3
53+ , uri-bytestring >= 0.1.7 && < 0.4
54+ , uuid-types >= 1.0.2 && <1.1
6655 if flag(use-text-show)
6756 cpp-options: -DUSE_TEXT_SHOW
68− build-depends: text-show >= 3.8.2 && <3.10
69−
57+ build-depends: text-show >= 2
7058 exposed-modules:
7159 Web.HttpApiData
7260 Web.FormUrlEncoded
@@ -85,26 +73,31 @@ test-suite spec
8573 hs-source-dirs: test
8674 ghc-options: -Wall
8775 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
76+ build-tool-depends: hspec-discover:hspec-discover
77+ build-depends: HUnit
78+ , hspec >= 1.3
79+ , base >= 4 && < 5
9380 , bytestring
94− , cookie
81+ , QuickCheck >=2.9
82+ , quickcheck-instances >= 0.3.12
83+ , unordered-containers
9584 , http-api-data
9685 , text
97− , time-compat
98− , unordered-containers
99− , uuid-types
100−
101− if !impl(ghc >= 7.10)
102− build-depends: nats
86+ , time
87+ , bytestring
88+ , uuid
10389
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
90+test-suite doctests
91+ ghc-options: -Wall
92+ build-depends:
93+ base,
94+ directory >= 1.0,
95+ doctest >= 0.11 && <0.14,
96+ filepath
97+ default-language: Haskell2010
98+ hs-source-dirs: test
99+ main-is: doctests.hs
100+ type: exitcode-stdio-1.0
108101
109102source-repository head
110103 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+82−275
@@ -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
@@ -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/Web/Internal/HttpApiDataSpec.hs+103−60
@@ -1,38 +1,31 @@
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
32−
33−import Web.Internal.HttpApiData
34−
35−import Web.Internal.TestInstances
28+import Web.Internal.TestInstances
3629
3730(<=>) :: forall a b. (Show a, Show b, Eq a) => (a -> b) -> (b -> Either T.Text a) -> a -> Property
3831(f <=> g) x = counterexample
@@ -46,24 +39,30 @@ import Web.Internal.TestInstances
4639encodedUrlPieceProp :: ToHttpApiData a => a -> Property
4740encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x)
4841
49−-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility
42+
5043checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
51−checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a)
44+checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Property)
5245
46+-- | Check with given generator
5347checkUrlPiece' :: 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
48+checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)
5949
6050-- | Check case insensitivity for @parseUrlPiece@.
6151checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
6252checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
6353
54+-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.
55+checkEncodedUrlPiece :: forall a. (Show a, ToHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
56+checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a)
57+
58+-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.
59+-- Use a given generator.
60+checkEncodedUrlPiece' :: forall a. (Show a, ToHttpApiData a) => Gen a -> String -> Spec
61+checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp
62+
6463spec :: Spec
6564spec = do
66− describe "Instances" $ do
65+ describe "toUrlPiece <=> parseUrlPiece" $ do
6766 checkUrlPiece (Proxy :: Proxy ()) "()"
6867 checkUrlPiece (Proxy :: Proxy Char) "Char"
6968 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
@@ -83,34 +82,59 @@ spec = do
8382 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
8483 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
8584 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"
85+ checkUrlPiece' timeOfDayGen "TimeOfDay"
86+ checkUrlPiece' localTimeGen "LocalTime"
87+ checkUrlPiece' zonedTimeGen "ZonedTime"
88+ checkUrlPiece' utcTimeGen "UTCTime"
89+ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"
9690 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"
91+ checkUrlPiece' uuidGen "UUID"
10792
10893 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
10994 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
11095 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
11196 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
11297
98+#if MIN_VERSION_base(4,8,0)
11399 checkUrlPiece (Proxy :: Proxy Natural) "Natural"
100+#endif
101+
102+ describe "toEncodedUrlPiece encodes correctly" $ do
103+ checkEncodedUrlPiece (Proxy :: Proxy ()) "()"
104+ checkEncodedUrlPiece (Proxy :: Proxy Char) "Char"
105+ checkEncodedUrlPiece (Proxy :: Proxy Bool) "Bool"
106+ checkEncodedUrlPiece (Proxy :: Proxy Ordering) "Ordering"
107+ checkEncodedUrlPiece (Proxy :: Proxy Int) "Int"
108+ checkEncodedUrlPiece (Proxy :: Proxy Int8) "Int8"
109+ checkEncodedUrlPiece (Proxy :: Proxy Int16) "Int16"
110+ checkEncodedUrlPiece (Proxy :: Proxy Int32) "Int32"
111+ checkEncodedUrlPiece (Proxy :: Proxy Int64) "Int64"
112+ checkEncodedUrlPiece (Proxy :: Proxy Integer) "Integer"
113+ checkEncodedUrlPiece (Proxy :: Proxy Word) "Word"
114+ checkEncodedUrlPiece (Proxy :: Proxy Word8) "Word8"
115+ checkEncodedUrlPiece (Proxy :: Proxy Word16) "Word16"
116+ checkEncodedUrlPiece (Proxy :: Proxy Word32) "Word32"
117+ checkEncodedUrlPiece (Proxy :: Proxy Word64) "Word64"
118+ checkEncodedUrlPiece (Proxy :: Proxy String) "String"
119+ checkEncodedUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
120+ checkEncodedUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
121+ checkEncodedUrlPiece (Proxy :: Proxy Day) "Day"
122+ checkEncodedUrlPiece' timeOfDayGen "TimeOfDay"
123+ checkEncodedUrlPiece' localTimeGen "LocalTime"
124+ checkEncodedUrlPiece' zonedTimeGen "ZonedTime"
125+ checkEncodedUrlPiece' utcTimeGen "UTCTime"
126+ checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"
127+ checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"
128+ checkEncodedUrlPiece' uuidGen "UUID"
129+
130+ checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
131+ checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
132+ checkEncodedUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
133+ checkEncodedUrlPiece (Proxy :: Proxy (Either Version Day)) "Either Version Day"
134+
135+#if MIN_VERSION_base(4,8,0)
136+ checkEncodedUrlPiece (Proxy :: Proxy Natural) "Natural"
137+#endif
114138
115139 it "bad integers are rejected" $ do
116140 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
@@ -122,8 +146,27 @@ spec = do
122146 it "invalid utf8 is handled" $ do
123147 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
124148
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 }
149+
150+uuidGen :: Gen UUID.UUID
151+uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
152+
153+-- TODO: this generators don't generate full range items
154+localTimeGen :: Gen LocalTime
155+localTimeGen = LocalTime <$> arbitrary <*> timeOfDayGen
156+
157+timeOfDayGen :: Gen TimeOfDay
158+timeOfDayGen = TimeOfDay
159+ <$> choose (0, 23)
160+ <*> choose (0, 59)
161+ <*> fmap (\x -> 0.1 * fromInteger x) (choose (0, 600))
162+
163+zonedTimeGen :: Gen ZonedTime
164+zonedTimeGen = ZonedTime
165+ <$> localTimeGen -- Note: not arbitrary!
166+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
167+
168+utcTimeGen :: Gen UTCTime
169+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
170+
171+nominalDiffTimeGen :: Gen NominalDiffTime
172+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
test/doctests.hsnew file+25
@@ -0,0 +1,25 @@
1+-----------------------------------------------------------------------------
2+-- |
3+-- Module : Main (doctests)
4+-- Copyright : (C) 2012-14 Edward Kmett
5+-- License : BSD-style (see the file LICENSE)
6+-- Maintainer : Edward Kmett <ekmett@gmail.com>
7+-- Stability : provisional
8+-- Portability : portable
9+--
10+-- This module provides doctests for a project based on the actual versions
11+-- of the packages it was built with. It requires a corresponding Setup.lhs
12+-- to be added to the project
13+-----------------------------------------------------------------------------
14+module Main where
15+
16+import Build_doctests (flags, pkgs, module_sources)
17+import Data.Foldable (traverse_)
18+import Test.DocTest
19+
20+main :: IO ()
21+main = do
22+ traverse_ putStrLn args
23+ doctest args
24+ where
25+ args = flags ++ pkgs ++ module_sources