git.iko.soy/typeable/http-api-data
on 08d1b70 help sign in
.ghcinew file+1
since splitsnapshots
unifiedsplit
@@ -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−2
@@ -1,6 +1,4 @@
1/dist/
1/dist/
2−/dist-newstyle/
3−/.ghc.environment.*
4/.shelly/
2/.shelly/
5/tarballs/
3/tarballs/
6*.swp
4*.swp
.travis.ymlnew file+108
@@ -0,0 +1,108 @@
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: TEST=--disable-tests BENCH=--disable-benchmarks
40+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}
41+
42+ allow_failures:
43+ - compiler: "ghc-head"
44+
45+before_install:
46+ - HC=${CC}
47+ - unset CC
48+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
49+ - PKGNAME='http-api-data'
50+
51+install:
52+ - cabal --version
53+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
54+ - BENCH=${BENCH---enable-benchmarks}
55+ - TEST=${TEST---enable-tests}
56+ - travis_retry cabal update -v
57+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
58+ # Soon we'll have build-tool-depends: in cabal-head
59+ - cabal get hspec-discover-2.3.2
60+ - cd hspec-discover-2.3.2
61+ - cabal new-build hspec-discover:exe:hspec-discover
62+ - mkdir -p ~/.local/bin
63+ - shopt -s globstar; cp dist-newstyle/**/hspec-discover/hspec-discover ~/.local/bin
64+ - cd ..
65+ # Continue
66+ - rm -fv cabal.project.local
67+ - "echo 'packages: .' > cabal.project"
68+ - rm -f cabal.project.freeze
69+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2
70+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2
71+
72+# Here starts the actual work to be performed for the package under test;
73+# any command which exits with a non-zero exit code causes the build to fail.
74+script:
75+ - if [ -f configure.ac ]; then autoreconf -i; fi
76+ - rm -rf dist/
77+ - cabal sdist # test that a source-distribution can be generated
78+ - cd dist/
79+ - SRCTAR=(${PKGNAME}-*.tar.gz)
80+ - SRC_BASENAME="${SRCTAR/%.tar.gz}"
81+ - tar -xvf "./$SRC_BASENAME.tar.gz"
82+ - cd "$SRC_BASENAME/"
83+## from here on, CWD is inside the extracted source-tarball
84+ - rm -fv cabal.project.local
85+ - "echo 'packages: .' > cabal.project"
86+ # this builds all libraries and executables (without tests/benchmarks)
87+ - rm -f cabal.project.freeze
88+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks
89+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --flag http-api-data:use-text-show
90+ # this builds all libraries and executables (including tests/benchmarks)
91+ # - rm -rf ./dist-newstyle
92+ - cabal new-build -w ${HC} ${TEST} ${BENCH}
93+
94+ # there's no 'cabal new-test' yet, so let's emulate for now
95+ - TESTS=( $(awk 'tolower($0) ~ /^test-suite / { print $2 }' *.cabal) )
96+ - if [ "$TEST" != "--enable-tests" ]; then TESTS=(); fi
97+ - shopt -s globstar;
98+ RC=true; for T in ${TESTS[@]}; do echo "== $T ==";
99+ if dist-newstyle/build/**/$SRC_BASENAME/**/build/$T/$T; then echo "= $T OK =";
100+ else echo "= $T FAILED ="; RC=false; fi; done; $RC
101+
102+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --flag http-api-data:use-text-show
103+ - shopt -s globstar;
104+ RC=true; for T in ${TESTS[@]}; do echo "== $T ==";
105+ if dist-newstyle/build/**/$SRC_BASENAME/**/build/$T/$T; then echo "= $T OK =";
106+ else echo "= $T FAILED ="; RC=false; fi; done; $RC
107+
108+# EOF
CHANGELOG.md−109
@@ -1,112 +1,3 @@
1−0.5
2−---
3−
4−* Use `attoparsec-iso8601-1.1.0.0`.
5− `Day` and `UTCTime` parsers require at least 4 digits now, which is a breaking change.
6−* Drop GHC-7.8 and GHC-7.10 support.
7−
8−0.4.3
9−-----
10−
11−* Add `Quarter`, `QuarterOfYear` and `Month` instances
12−* Support `bytestring-0.11`
13−
14−0.4.2
15−-----
16−
17−* Add instances for `Const` and `Identity`
18−
19−0.4.1.1
20−-------
21−
22−* Allow cookie <0.5
23−* Change to `build-type: Simple`
24−
25−0.4.1
26−-----
27−
28−* Use `time-compat` to provide instances for `DayOfWeek`.
29−
30−0.4
31−---
32−
33−* `NominalDiffTime` instances preserve precision (roundtrip)
34−* Add `Semigroup.Min`, `Max`, `First`, `Last` instances
35−* Add `Tagged b a` instances
36−
37−0.3.10
38−---
39−
40−* Fix 'SetCookie' instances
41− (see [#86](https://github.com/fizruk/http-api-data/pull/86))
42−* Add support for `Fixed`
43− (see [#78](https://github.com/fizruk/http-api-data/pull/87))
44−
45−0.3.9
46−---
47−
48−* GHC-8.6 support
49−* Remove dependency on `uri-bytestring` and use functions from `http-types` instead
50− (see [#75](https://github.com/fizruk/http-api-data/pull/75))
51−* Add support for `SetCookie`
52− (see [#74](https://github.com/fizruk/http-api-data/pull/74))
53−
54−0.3.8.1
55−---
56−
57−* GHC-8.4.1 support
58−
59−0.3.8
60−---
61−
62−* Minor changes:
63− * Stable URL-encoding for `Form`s (see [#67](https://github.com/fizruk/http-api-data/pull/67)):
64− * Introduce `urlEncodeParams` and `urlDecodeParams`;
65− * Introduce `urlEncodeAsFormStable` and use stable encoding for doctests;
66− * Add `toEntriesByKeyStable` and `toListStable`;
67− * Add `Semigroup` instance for `Form` (see [#69](https://github.com/fizruk/http-api-data/pull/69));
68− * Relax upper bound on Cabal (see [#73](https://github.com/fizruk/http-api-data/pull/73)).
69−
70−0.3.7.2
71−---
72−
73−* Allow http-types-0.12
74−* .cabal file adjustments
75−
76−0.3.7.1
77−---
78−
79−* GHC-8.2 support (see [#55](https://github.com/fizruk/http-api-data/pull/55)).
80−
81−0.3.7
82−---
83−
84−* Minor changes:
85− * Use [`attoparsec-iso8601`](http://hackage.haskell.org/package/attoparsec-iso8601)
86− for parsing of time types. Now the accepted formats are the same as by `aeson`,
87− i.e. parsers are more lenient
88− (see [#41](https://github.com/fizruk/http-api-data/pull/41));
89− * Preserve fractions of a second in `ToHttpApiData` instances (see [#53](https://github.com/fizruk/http-api-data/pull/53));
90− * Add `ToHttpApiData` and `FromHttpApiData` instances for `TimeOfDay` (see [#53](https://github.com/fizruk/http-api-data/pull/53)).
91−
92−0.3.6
93−---
94−
95−* Minor change:
96− * Add `toEncodedUrlPiece` class method for URL-encoded path segments (see [#50](https://github.com/fizruk/http-api-data/pull/50)); use efficient encoding for types whose values don't need URL-encoding.
97−
98−0.3.5
99−---
100−
101−* Minor changes:
102− * Add `LenientData` which always succeeds to parse (see [#45](https://github.com/fizruk/http-api-data/pull/45)).
103−
104−0.3.4
105−---
106−
107−* Minor changes:
108− * Add support for GHC 8.2, drop support for GHC 7.6 (see [#44](https://github.com/fizruk/http-api-data/pull/44)).
109−
1100.3.3
10.3.3
111---
2---
112
3
Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
Setup.lhsnew file+48
@@ -0,0 +1,48 @@
1+#!/usr/bin/runhaskell
2+\begin{code}
3+{-# OPTIONS_GHC -Wall #-}
4+module Main (main) where
5+
6+import Data.List ( nub )
7+import Data.Version ( showVersion )
8+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )
9+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
10+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
11+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )
12+import Distribution.Simple.BuildPaths ( autogenModulesDir )
13+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )
14+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
15+import Distribution.Verbosity ( Verbosity )
16+import System.FilePath ( (</>) )
17+
18+main :: IO ()
19+main = defaultMainWithHooks simpleUserHooks
20+ { buildHook = \pkg lbi hooks flags -> do
21+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
22+ buildHook simpleUserHooks pkg lbi hooks flags
23+ }
24+
25+generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
26+generateBuildModule verbosity pkg lbi = do
27+ let dir = autogenModulesDir lbi
28+ createDirectoryIfMissingVerbose verbosity True dir
29+ withLibLBI pkg lbi $ \_ libcfg -> do
30+ withTestLBI pkg lbi $ \suite suitecfg -> do
31+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines
32+ [ "module Build_" ++ testName suite ++ " where"
33+ , ""
34+ , "autogen_dir :: String"
35+ , "autogen_dir = " ++ show dir
36+ , ""
37+ , "deps :: [String]"
38+ , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
39+ ]
40+ where
41+ formatdeps = map (formatone . snd)
42+ formatone p = case packageName p of
43+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
44+
45+testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
46+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
47+
48+\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+40−60
@@ -1,38 +1,26 @@
1−cabal-version: >= 1.10
2name: http-api-data
1name: http-api-data
3−version: 0.5
2+version: 0.3.3
4−
5−synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.
6−category: Web
7−description:
8− This package defines typeclasses used for converting Haskell data types to and from HTTP API data.
9− .
10− Please see README.md
11−
12license: BSD3
3license: BSD3
13license-file: LICENSE
4license-file: LICENSE
14author: Nickolay Kudasov <nickolay.kudasov@gmail.com>
5author: Nickolay Kudasov <nickolay.kudasov@gmail.com>
15maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>
6maintainer: Nickolay Kudasov <nickolay.kudasov@gmail.com>
7+synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.
8+description: Please see README.md
16homepage: http://github.com/fizruk/http-api-data
9homepage: http://github.com/fizruk/http-api-data
10+category: Web
17stability: unstable
11stability: unstable
12+cabal-version: >= 1.10
18−build-type: Simple
13+build-type: Custom
19−
20extra-source-files:
14extra-source-files:
21 include/overlapping-compat.h
15 include/overlapping-compat.h
22 test/*.hs
16 test/*.hs
23 CHANGELOG.md
17 CHANGELOG.md
24 README.md
18 README.md
25−
26tested-with:
19tested-with:
20+ GHC==7.8.4,
21+ GHC==7.10.3,
27 GHC==8.0.2,
22 GHC==8.0.2,
28− GHC==8.2.2,
23+ GHC==8.1.*
29− GHC==8.4.4,
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
36
24
37flag use-text-show
25flag use-text-show
38 description: Use text-show library for efficient ToHttpApiData implementations.
26 description: Use text-show library for efficient ToHttpApiData implementations.
@@ -42,31 +30,19 @@ flag use-text-show
42library
30library
43 hs-source-dirs: src/
31 hs-source-dirs: src/
44 include-dirs: include/
32 include-dirs: include/
45−
46− -- GHC bundled
47− build-depends: base >= 4.9 && < 4.17
33+ build-depends: base >= 4.7 && < 4.10
48− , bytestring >= 0.10.8.1 && < 0.12
34+ , bytestring
49− , containers >= 0.5.7.1 && < 0.7
35+ , containers
50− , text >= 1.2.3.0 && < 1.3 || >=2.0 && <2.1
51− , transformers >= 0.5.2.0 && < 0.7
52−
53− -- other-dependencies
54− build-depends:
55− attoparsec >= 0.13.2.2 && < 0.15
56− , attoparsec-iso8601 >= 1.1.0.0 && < 1.2
57− , base-compat >= 0.10.5 && < 0.13
58− , cookie >= 0.4.3 && < 0.5
59− , hashable >= 1.2.7.0 && < 1.5
36+ , hashable
60− , http-types >= 0.12.3 && < 0.13
37+ , text >= 0.5
61− , tagged >= 0.8.5 && < 0.9
38+ , time
62− , time-compat >= 1.9.5 && < 1.10
39+ , time-locale-compat >=0.1.1.0 && <0.2
63− , unordered-containers >= 0.2.10.0 && < 0.3
40+ , unordered-containers
41+ , uri-bytestring
64− , uuid-types >= 1.0.3 && < 1.1
42+ , uuid-types >= 1.0.2 && <1.1
65−
66 if flag(use-text-show)
43 if flag(use-text-show)
67 cpp-options: -DUSE_TEXT_SHOW
44 cpp-options: -DUSE_TEXT_SHOW
68− build-depends: text-show >= 3.8.2 && <3.10
45+ build-depends: text-show >= 2
69−
70 exposed-modules:
46 exposed-modules:
71 Web.HttpApiData
47 Web.HttpApiData
72 Web.FormUrlEncoded
48 Web.FormUrlEncoded
@@ -85,26 +61,30 @@ test-suite spec
85 hs-source-dirs: test
61 hs-source-dirs: test
86 ghc-options: -Wall
62 ghc-options: -Wall
87 default-language: Haskell2010
63 default-language: Haskell2010
88− build-tool-depends: hspec-discover:hspec-discover >= 2.7.1 && <2.11
64+ build-depends: HUnit
89− -- inherited depndencies
65+ , hspec >= 1.3
90− build-depends:
66+ , base >= 4 && < 5
91− base
92− , base-compat
93 , bytestring
67 , bytestring
94− , cookie
68+ , QuickCheck >=2.9
69+ , quickcheck-instances >= 0.3.12
70+ , unordered-containers
95 , http-api-data
71 , http-api-data
96 , text
72 , text
97− , time-compat
73+ , time
98− , unordered-containers
74+ , bytestring
99− , uuid-types
75+ , uuid
100−
101− if !impl(ghc >= 7.10)
102− build-depends: nats
103
76
77+test-suite doctest
78+ ghc-options: -Wall
104− build-depends: HUnit >= 1.6.0.0 && <1.7
79+ build-depends:
105− , hspec >= 2.7.1 && <2.11
80+ base,
106− , QuickCheck >= 2.13.1 && <2.15
81+ directory >= 1.0,
107− , quickcheck-instances >= 0.3.25.2 && <0.4
82+ doctest >= 0.11 && <0.12,
83+ filepath
84+ default-language: Haskell2010
85+ hs-source-dirs: test
86+ main-is: DocTest.hs
87+ type: exitcode-stdio-1.0
108
88
109source-repository head
89source-repository head
110 type: git
90 type: git
src/Web/FormUrlEncoded.hs+1−8
@@ -14,11 +14,9 @@ module Web.FormUrlEncoded (
14
14
15 -- * Encoding and decoding @'Form'@s
15 -- * Encoding and decoding @'Form'@s
16 urlEncodeAsForm,
16 urlEncodeAsForm,
17− urlEncodeAsFormStable,
18 urlDecodeAsForm,
17 urlDecodeAsForm,
19
18
20 urlEncodeForm,
19 urlEncodeForm,
21− urlEncodeFormStable,
22 urlDecodeForm,
20 urlDecodeForm,
23
21
24 -- * 'Generic's
22 -- * 'Generic's
@@ -30,9 +28,7 @@ module Web.FormUrlEncoded (
30 defaultFormOptions,
28 defaultFormOptions,
31
29
32 -- * Helpers
30 -- * Helpers
33− toListStable,
34 toEntriesByKey,
31 toEntriesByKey,
35− toEntriesByKeyStable,
36 fromEntriesByKey,
32 fromEntriesByKey,
37
33
38 lookupAll,
34 lookupAll,
@@ -42,10 +38,7 @@ module Web.FormUrlEncoded (
42 parseAll,
38 parseAll,
43 parseMaybe,
39 parseMaybe,
44 parseUnique,
40 parseUnique,
45−
46− urlEncodeParams,
47− urlDecodeParams,
48) where
41) where
49
42
50−import Web.Internal.FormUrlEncoded
43+import Web.Internal.FormUrlEncoded
51
44
src/Web/HttpApiData.hs+3−5
@@ -35,23 +35,21 @@ module Web.HttpApiData (
35 parseBoundedEnumOfI,
35 parseBoundedEnumOfI,
36 parseBoundedTextData,
36 parseBoundedTextData,
37
37
38− -- * Lenient data
39− LenientData (..),
40−
41 -- * Other helpers
38 -- * Other helpers
42 showTextData,
39 showTextData,
43 readTextData,
40 readTextData,
44) where
41) where
45
42
46−import Web.Internal.HttpApiData
43+import Web.Internal.HttpApiData
47
44
48-- $setup
45-- $setup
49--
46--
50-- >>> :set -XOverloadedStrings
47-- >>> :set -XOverloadedStrings
51-- >>> import Control.Applicative
48-- >>> import Control.Applicative
52−-- >>> import Data.Time.Compat
49+-- >>> import Data.Time
53-- >>> import Data.Int
50-- >>> import Data.Int
54-- >>> import Data.Text (Text)
51-- >>> import Data.Text (Text)
52+-- >>> import Data.Time (Day)
55-- >>> import Data.Version
53-- >>> import Data.Version
56
54
57-- $examples
55-- $examples
src/Web/Internal/FormUrlEncoded.hs+59−141
@@ -17,51 +17,50 @@
17#include "overlapping-compat.h"
17#include "overlapping-compat.h"
18module Web.Internal.FormUrlEncoded where
18module Web.Internal.FormUrlEncoded where
19
19
20−import Prelude ()
20+#if __GLASGOW_HASKELL__ < 710
21−import Prelude.Compat
21+import Control.Applicative
22+import Data.Traversable
23+#endif
24+
22
25
23−import Control.Applicative (Const(Const))
24import Control.Arrow ((***))
26import Control.Arrow ((***))
25import Control.Monad ((<=<))
27import Control.Monad ((<=<))
26−import Data.ByteString.Builder (shortByteString, toLazyByteString)
28+import Data.ByteString.Builder (toLazyByteString, shortByteString)
27import qualified Data.ByteString.Lazy as BSL
29import qualified Data.ByteString.Lazy as BSL
28import qualified Data.ByteString.Lazy.Char8 as BSL8
30import qualified Data.ByteString.Lazy.Char8 as BSL8
29−import Data.Coerce (coerce)
30import qualified Data.Foldable as F
31import qualified Data.Foldable as F
31−import Data.Functor.Identity (Identity(Identity))
32import Data.Hashable (Hashable)
32import Data.Hashable (Hashable)
33import Data.HashMap.Strict (HashMap)
33import Data.HashMap.Strict (HashMap)
34import qualified Data.HashMap.Strict as HashMap
34import qualified Data.HashMap.Strict as HashMap
35−import Data.Int (Int16, Int32, Int64, Int8)
35+import Data.Int
36import Data.IntMap (IntMap)
36import Data.IntMap (IntMap)
37import qualified Data.IntMap as IntMap
37import qualified Data.IntMap as IntMap
38−import Data.List (intersperse, sortBy)
38+import Data.List (intersperse)
39import Data.Map (Map)
39import Data.Map (Map)
40import qualified Data.Map as Map
40import qualified Data.Map as Map
41−import Data.Monoid (All (..), Any (..), Dual (..),
41+import Data.Monoid
42− Product (..), Sum (..))
42+
43−import Data.Ord (comparing)
44−import Data.Proxy (Proxy (..))
45−import Data.Semigroup (Semigroup (..))
46−import qualified Data.Semigroup as Semi
47−import Data.Tagged (Tagged (..))
48import Data.Text (Text)
43import Data.Text (Text)
49import qualified Data.Text as Text
44import qualified Data.Text as Text
50−import qualified Data.Text.Encoding as Text
51−import Data.Text.Encoding.Error (lenientDecode)
52import qualified Data.Text.Lazy as Lazy
45import qualified Data.Text.Lazy as Lazy
53−import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
46+import Data.Text.Encoding as Text
54− UTCTime, ZonedTime)
47+import Data.Text.Encoding.Error (lenientDecode)
55−import Data.Time.Calendar.Month.Compat (Month)
48+
56−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
49+import Data.Time
57−import Data.Void (Void)
50+import Data.Proxy
58−import Data.Word (Word16, Word32, Word64, Word8)
51+import Data.Word
52+
53+#if MIN_VERSION_base(4,8,0)
54+import Data.Void
55+import Numeric.Natural
56+#endif
57+
59−import GHC.Exts (Constraint, IsList (..))
58+import GHC.Exts (IsList (..), Constraint)
60import GHC.Generics
59import GHC.Generics
61import GHC.TypeLits
60import GHC.TypeLits
62−import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)
61+import URI.ByteString (urlEncodeQuery, urlDecodeQuery)
63−import Numeric.Natural (Natural)
62+
64−import Web.Internal.HttpApiData
63+import Web.Internal.HttpApiData
65
64
66-- $setup
65-- $setup
67-- >>> :set -XDeriveGeneric
66-- >>> :set -XDeriveGeneric
@@ -115,9 +114,6 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam
115instance ToFormKey ZonedTime where toFormKey = toQueryParam
114instance ToFormKey ZonedTime where toFormKey = toQueryParam
116instance ToFormKey UTCTime where toFormKey = toQueryParam
115instance ToFormKey UTCTime where toFormKey = toQueryParam
117instance ToFormKey NominalDiffTime where toFormKey = toQueryParam
116instance ToFormKey NominalDiffTime where toFormKey = toQueryParam
118−instance ToFormKey Quarter where toFormKey = toQueryParam
119−instance ToFormKey QuarterOfYear where toFormKey = toQueryParam
120−instance ToFormKey Month where toFormKey = toQueryParam
121
117
122instance ToFormKey String where toFormKey = toQueryParam
118instance ToFormKey String where toFormKey = toQueryParam
123instance ToFormKey Text where toFormKey = toQueryParam
119instance ToFormKey Text where toFormKey = toQueryParam
@@ -126,26 +122,14 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam
126instance ToFormKey All where toFormKey = toQueryParam
122instance ToFormKey All where toFormKey = toQueryParam
127instance ToFormKey Any where toFormKey = toQueryParam
123instance ToFormKey Any where toFormKey = toQueryParam
128
124
129−instance ToFormKey a => ToFormKey (Dual a) where toFormKey = coerce (toFormKey :: a -> Text)
125+instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getDual
130−instance ToFormKey a => ToFormKey (Sum a) where toFormKey = coerce (toFormKey :: a -> Text)
126+instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
131−instance ToFormKey a => ToFormKey (Product a) where toFormKey = coerce (toFormKey :: a -> Text)
127+instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
132−
133−instance ToFormKey a => ToFormKey (Semi.Min a) where toFormKey = coerce (toFormKey :: a -> Text)
134−instance ToFormKey a => ToFormKey (Semi.Max a) where toFormKey = coerce (toFormKey :: a -> Text)
135−instance ToFormKey a => ToFormKey (Semi.First a) where toFormKey = coerce (toFormKey :: a -> Text)
136−instance ToFormKey a => ToFormKey (Semi.Last a) where toFormKey = coerce (toFormKey :: a -> Text)
137−
138−instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text)
139−
140−-- | @since 0.4.2
141−instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text)
142−
143−-- | @since 0.4.2
144−instance ToFormKey a => ToFormKey (Const a b) where
145− toFormKey = coerce (toFormKey :: a -> Text)
146
128
129+#if MIN_VERSION_base(4,8,0)
147instance ToFormKey Void where toFormKey = toQueryParam
130instance ToFormKey Void where toFormKey = toQueryParam
148instance ToFormKey Natural where toFormKey = toQueryParam
131instance ToFormKey Natural where toFormKey = toQueryParam
132+#endif
149
133
150-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
134-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
151class FromFormKey k where
135class FromFormKey k where
@@ -177,9 +161,6 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam
177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
161instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
178instance FromFormKey UTCTime where parseFormKey = parseQueryParam
162instance FromFormKey UTCTime where parseFormKey = parseQueryParam
179instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam
163instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam
180−instance FromFormKey Quarter where parseFormKey = parseQueryParam
181−instance FromFormKey QuarterOfYear where parseFormKey = parseQueryParam
182−instance FromFormKey Month where parseFormKey = parseQueryParam
183
164
184instance FromFormKey String where parseFormKey = parseQueryParam
165instance FromFormKey String where parseFormKey = parseQueryParam
185instance FromFormKey Text where parseFormKey = parseQueryParam
166instance FromFormKey Text where parseFormKey = parseQueryParam
@@ -188,48 +169,30 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam
188instance FromFormKey All where parseFormKey = parseQueryParam
169instance FromFormKey All where parseFormKey = parseQueryParam
189instance FromFormKey Any where parseFormKey = parseQueryParam
170instance FromFormKey Any where parseFormKey = parseQueryParam
190
171
191−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
172+instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . parseFormKey
192−instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
173+instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
193−instance FromFormKey a => FromFormKey (Product a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
194−
195−instance FromFormKey a => FromFormKey (Semi.Min a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
196−instance FromFormKey a => FromFormKey (Semi.Max a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
197−instance FromFormKey a => FromFormKey (Semi.First a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
198−instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
199−
200−instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
174+instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
201−
202−-- | @since 0.4.2
203−instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
204−
205−-- | @since 0.4.2
206−instance FromFormKey a => FromFormKey (Const a b) where
207− parseFormKey = coerce (parseFormKey :: Text -> Either Text a)
208
175
176+#if MIN_VERSION_base(4,8,0)
209instance FromFormKey Void where parseFormKey = parseQueryParam
177instance FromFormKey Void where parseFormKey = parseQueryParam
210instance FromFormKey Natural where parseFormKey = parseQueryParam
178instance FromFormKey Natural where parseFormKey = parseQueryParam
179+#endif
211
180
212-- | The contents of a form, not yet URL-encoded.
181-- | The contents of a form, not yet URL-encoded.
213--
182--
214-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
183-- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.
215newtype Form = Form { unForm :: HashMap Text [Text] }
184newtype Form = Form { unForm :: HashMap Text [Text] }
216− deriving (Eq, Read, Generic, Semigroup, Monoid)
185+ deriving (Eq, Read, Generic, Monoid)
217
186
218instance Show Form where
187instance Show Form where
219 showsPrec d form = showParen (d > 10) $
188 showsPrec d form = showParen (d > 10) $
220− showString "fromList " . shows (toListStable form)
189+ showString "fromList " . shows (toList form)
221
190
222−-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values).
223−-- For a stable conversion use 'toListStable'.
224instance IsList Form where
191instance IsList Form where
225 type Item Form = (Text, Text)
192 type Item Form = (Text, Text)
226 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
193 fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v]))
227 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
194 toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm
228
195
229−-- | A stable version of 'toList'.
230−toListStable :: Form -> [(Text, Text)]
231−toListStable = sortOn fst . toList
232−
233-- | Convert a value into 'Form'.
196-- | Convert a value into 'Form'.
234--
197--
235-- An example type and instance:
198-- An example type and instance:
@@ -340,7 +303,7 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint
340-- instance 'ToForm' Post
303-- instance 'ToForm' Post
341-- @
304-- @
342--
305--
343−-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
306+-- >>> urlEncodeAsForm Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] }
344-- "comments=Nice%20post%21&comments=%2B1&title=Test"
307-- "comments=Nice%20post%21&comments=%2B1&title=Test"
345genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
308genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form
346genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
309genericToForm opts = gToForm (Proxy :: Proxy a) opts . from
@@ -425,7 +388,6 @@ class FromForm a where
425
388
426instance FromForm Form where fromForm = pure
389instance FromForm Form where fromForm = pure
427
390
428−-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values).
429instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
391instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where
430 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
392 fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey
431
393
@@ -440,22 +402,13 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where
440
402
441-- | Parse a 'Form' into a list of entries groupped by key.
403-- | Parse a 'Form' into a list of entries groupped by key.
442--
404--
443−-- _NOTE:_ this conversion is unstable and may result in different key order
405+-- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
444−-- (but not values). For a stable encoding see 'toEntriesByKeyStable'.
406+-- Right [("color",["red","white"]),("name",["Nick"])]
445toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
407toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
446toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
408toEntriesByKey = traverse parseGroup . HashMap.toList . unForm
447 where
409 where
448 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
410 parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs
449
411
450−-- | Parse a 'Form' into a list of entries groupped by key.
451−--
452−-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])]
453−-- Right [("color",["red","white"]),("name",["Nick"])]
454−--
455−-- For an unstable (but faster) conversion see 'toEntriesByKey'.
456−toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])]
457−toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey
458−
459-- | A 'Generic'-based implementation of 'fromForm'.
412-- | A 'Generic'-based implementation of 'fromForm'.
460-- This is used as a default implementation in 'FromForm'.
413-- This is used as a default implementation in 'FromForm'.
461--
414--
@@ -529,53 +482,39 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where
529
482
530-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
483-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
531--
484--
532−-- _NOTE:_ this encoding is unstable and may result in different key order
533−-- (but not values). For a stable encoding see 'urlEncodeFormStable'.
534−urlEncodeForm :: Form -> BSL.ByteString
535−urlEncodeForm = urlEncodeParams . toList
536−
537−-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
538−--
539−-- For an unstable (but faster) encoding see 'urlEncodeForm'.
540−--
541-- Key-value pairs get encoded to @key=value@ and separated by @&@:
485-- Key-value pairs get encoded to @key=value@ and separated by @&@:
542--
486--
543−-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")]
487+-- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")]
544-- "lastname=Arni&name=Julian"
488-- "lastname=Arni&name=Julian"
545--
489--
546-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
490-- Keys with empty values get encoded to just @key@ (without the @=@ sign):
547--
491--
548−-- >>> urlEncodeFormStable [("is_test", "")]
492+-- >>> urlEncodeForm [("is_test", "")]
549-- "is_test"
493-- "is_test"
550--
494--
551-- Empty keys are allowed too:
495-- Empty keys are allowed too:
552--
496--
553−-- >>> urlEncodeFormStable [("", "foobar")]
497+-- >>> urlEncodeForm [("", "foobar")]
554-- "=foobar"
498-- "=foobar"
555--
499--
556−-- However, if both key and value are empty, the key-value pair is ignored.
500+-- However, if not key and value are empty, the key-value pair is ignored.
557−-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism).
501+-- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism).
558--
502--
559−-- >>> urlEncodeFormStable [("", "")]
503+-- >>> urlEncodeForm [("", "")]
560-- ""
504-- ""
561--
505--
562-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
506-- Everything is escaped with @'escapeURIString' 'isUnreserved'@:
563--
507--
564−-- >>> urlEncodeFormStable [("fullname", "Andres Löh")]
508+-- >>> urlEncodeForm [("fullname", "Andres Löh")]
565-- "fullname=Andres%20L%C3%B6h"
509-- "fullname=Andres%20L%C3%B6h"
566−urlEncodeFormStable :: Form -> BSL.ByteString
510+urlEncodeForm :: Form -> BSL.ByteString
567−urlEncodeFormStable = urlEncodeParams . sortOn fst . toList
568−
569−-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'.
570−--
571−-- See also 'urlEncodeFormStable'.
572−urlEncodeParams :: [(Text, Text)] -> BSL.ByteString
573−urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair
511+urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList
574 where
512 where
575− escape = urlEncodeBuilder True . Text.encodeUtf8
513+ escape = urlEncodeQuery . Text.encodeUtf8
576
514
577 encodePair (k, "") = escape k
515 encodePair (k, "") = escape k
578− encodePair (k, v) = escape k <> shortByteString "=" <> escape v
516+ encodePair (k, v) = escape k <> shortByteString "=" <> escape v
517+
579
518
580-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
519-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'.
581--
520--
@@ -609,17 +548,11 @@ urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&")
609-- >>> urlDecodeForm "this=has=too=many=equals"
548-- >>> urlDecodeForm "this=has=too=many=equals"
610-- Left "not a valid pair: this=has=too=many=equals"
549-- Left "not a valid pair: this=has=too=many=equals"
611urlDecodeForm :: BSL.ByteString -> Either Text Form
550urlDecodeForm :: BSL.ByteString -> Either Text Form
612−urlDecodeForm = fmap toForm . urlDecodeParams
613−
614−-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs.
615−--
616−-- See also 'urlDecodeForm'.
617−urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)]
618−urlDecodeParams bs = traverse parsePair pairs
551+urlDecodeForm bs = toForm <$> traverse parsePair pairs
619 where
552 where
620 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
553 pairs = map (BSL8.split '=') (BSL8.split '&' bs)
621
554
622− unescape = Text.decodeUtf8With lenientDecode . urlDecode True . BSL.toStrict
555+ unescape = Text.decodeUtf8With lenientDecode . urlDecodeQuery . BSL.toStrict
623
556
624 parsePair p =
557 parsePair p =
625 case map unescape p of
558 case map unescape p of
@@ -627,7 +560,6 @@ urlDecodeParams bs = traverse parsePair pairs
627 [k] -> return (k, "")
560 [k] -> return (k, "")
628 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
561 xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs
629
562
630−
631-- | This is a convenience function for decoding a
563-- | This is a convenience function for decoding a
632-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
564-- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype
633-- that has an instance of 'FromForm'.
565-- that has an instance of 'FromForm'.
@@ -645,22 +577,11 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm
645--
577--
646-- This is effectively @'urlEncodeForm' . 'toForm'@.
578-- This is effectively @'urlEncodeForm' . 'toForm'@.
647--
579--
648−-- _NOTE:_ this encoding is unstable and may result in different key order
580+-- >>> urlEncodeAsForm Person {name = "Dennis", age = 22}
649−-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'.
581+-- "age=22&name=Dennis"
650urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
582urlEncodeAsForm :: ToForm a => a -> BSL.ByteString
651urlEncodeAsForm = urlEncodeForm . toForm
583urlEncodeAsForm = urlEncodeForm . toForm
652
584
653−-- | This is a convenience function for encoding a datatype that has instance
654−-- of 'ToForm' directly to a @application/x-www-form-urlencoded@
655−-- 'BSL.ByteString'.
656−--
657−-- This is effectively @'urlEncodeFormStable' . 'toForm'@.
658−--
659−-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22}
660−-- "age=22&name=Dennis"
661−urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString
662−urlEncodeAsFormStable = urlEncodeFormStable . toForm
663−
664-- | Find all values corresponding to a given key in a 'Form'.
585-- | Find all values corresponding to a given key in a 'Form'.
665--
586--
666-- >>> lookupAll "name" []
587-- >>> lookupAll "name" []
@@ -771,8 +692,8 @@ parseUnique key form = lookupUnique key form >>= parseQueryParam
771-- 'fromForm' = 'genericFromForm' myOptions
692-- 'fromForm' = 'genericFromForm' myOptions
772-- @
693-- @
773--
694--
774−-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 }
695+-- >>> urlEncodeAsForm Project { projectName = "http-api-data", projectSize = 172 }
775−-- "name=http-api-data&size=172"
696+-- "size=172&name=http-api-data"
776-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
697-- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project
777-- Right (Project {projectName = "http-api-data", projectSize = 172})
698-- Right (Project {projectName = "http-api-data", projectSize = 172})
778data FormOptions = FormOptions
699data FormOptions = FormOptions
@@ -791,6 +712,3 @@ defaultFormOptions :: FormOptions
791defaultFormOptions = FormOptions
712defaultFormOptions = FormOptions
792 { fieldLabelModifier = id
713 { fieldLabelModifier = id
793 }
714 }
794−
795−sortOn :: Ord b => (a -> b) -> [a] -> [a]
796−sortOn f = sortBy (comparing f)
src/Web/Internal/HttpApiData.hs+101−380
@@ -1,86 +1,56 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
2+{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFoldable #-}
5−{-# LANGUAGE DeriveFunctor #-}
6−{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE KindSignatures #-}
9−{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeSynonymInstances #-}
6{-# LANGUAGE TypeSynonymInstances #-}
13-- |
7-- |
14-- Convert Haskell values to and from HTTP API data
8-- Convert Haskell values to and from HTTP API data
15-- such as URL pieces, headers and query parameters.
9-- such as URL pieces, headers and query parameters.
16module Web.Internal.HttpApiData where
10module Web.Internal.HttpApiData where
17
11
18−import Prelude ()
12+#if __GLASGOW_HASKELL__ < 710
19−import Prelude.Compat
20−
21−import Control.Applicative (Const(Const))
13+import Control.Applicative
14+import Data.Traversable (Traversable(traverse))
15+#endif
16+
22−import Control.Arrow (left, (&&&))
17+import Control.Arrow ((&&&), left)
23−import Control.Monad ((<=<))
18+import Control.Monad ((<=<))
24−import qualified Data.Attoparsec.Text as Atto
19+
25−import qualified Data.Attoparsec.Time as Atto
20+import Data.Monoid
26−import Data.ByteString (ByteString)
21+import Data.ByteString (ByteString)
27−import qualified Data.ByteString as BS
22+import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Builder as BS
23+
29−import qualified Data.ByteString.Lazy as LBS
24+import Data.Int
30−import Data.Coerce (coerce)
25+import Data.Word
31−import Data.Data (Data)
26+
32−import qualified Data.Fixed as F
27+import Data.Text (Text)
33−import Data.Functor.Identity (Identity(Identity))
34−import Data.Int (Int16, Int32, Int64, Int8)
35−import Data.Kind (Type)
36−import qualified Data.Map as Map
37−import Data.Monoid (All (..), Any (..), Dual (..),
38− First (..), Last (..),
39− Product (..), Sum (..))
40−import Data.Semigroup (Semigroup (..))
41−import qualified Data.Semigroup as Semi
42−import Data.Tagged (Tagged (..))
43−import Data.Text (Text)
44−import qualified Data.Text as T
28+import Data.Text.Encoding (encodeUtf8, decodeUtf8')
45−import Data.Text.Encoding (decodeUtf8', decodeUtf8With,
46− encodeUtf8)
47−import Data.Text.Encoding.Error (lenientDecode)
48−import qualified Data.Text.Lazy as L
49−import Data.Text.Read (Reader, decimal, rational,
29+import Data.Text.Read (signed, decimal, rational, Reader)
50− signed)
30+import qualified Data.Text as T
51−import Data.Time.Compat (Day, FormatTime, LocalTime,
31+import qualified Data.Text.Lazy as L
52− NominalDiffTime, TimeOfDay,
32+
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)
33+import Data.Time.Locale.Compat
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
34+import Data.Time
61− toYearQuarter)
62−import Data.Typeable (Typeable)
63−import qualified Data.UUID.Types as UUID
64−import Data.Version (Version, parseVersion,
35+import Data.Version
65− showVersion)
36+
66−import Data.Void (Void, absurd)
37+#if MIN_VERSION_base(4,8,0)
67−import Data.Word (Word16, Word32, Word64, Word8)
38+import Data.Void
68−import qualified Network.HTTP.Types as H
69−import Numeric.Natural (Natural)
39+import Numeric.Natural
40+#endif
41+
42+import Text.Read (readMaybe)
70−import Text.ParserCombinators.ReadP (readP_to_S)
43+import Text.ParserCombinators.ReadP (readP_to_S)
71−import Text.Read (readMaybe)
72−import Web.Cookie (SetCookie, parseSetCookie,
73− renderSetCookie)
74
44
75#if USE_TEXT_SHOW
45#if USE_TEXT_SHOW
76−import TextShow (TextShow, showt)
46+import TextShow (TextShow, showt)
77#endif
47#endif
78
48
49+import qualified Data.UUID.Types as UUID
50+
79-- $setup
51-- $setup
80-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
52-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
81-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
53-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
82−-- >>> import Data.Time.Compat
83−-- >>> import Data.Version
84
54
85-- | Convert value to HTTP API data.
55-- | Convert value to HTTP API data.
86--
56--
@@ -92,12 +62,6 @@ class ToHttpApiData a where
92 toUrlPiece :: a -> Text
62 toUrlPiece :: a -> Text
93 toUrlPiece = toQueryParam
63 toUrlPiece = toQueryParam
94
64
95− -- | Convert to a URL path piece, making sure to encode any special chars.
96− -- The default definition uses 'H.encodePathSegmentsRelative',
97− -- but this may be overriden with a more efficient version.
98− toEncodedUrlPiece :: a -> BS.Builder
99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
100−
101 -- | Convert to HTTP header value.
65 -- | Convert to HTTP header value.
102 toHeader :: a -> ByteString
66 toHeader :: a -> ByteString
103 toHeader = encodeUtf8 . toUrlPiece
67 toHeader = encodeUtf8 . toUrlPiece
@@ -338,7 +302,7 @@ lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
338-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
302-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
339-- Right True
303-- Right True
340--
304--
341−-- For case insensitive parser see 'parseBoundedEnumOfI'.
305+-- For case sensitive parser see 'parseBoundedEnumOfI'.
342parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
306parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
343parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
307parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
344
308
@@ -383,7 +347,7 @@ parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of
383-- Right 1991-06-02
347-- Right 1991-06-02
384--
348--
385-- This parser is case sensitive and will not match @'showTextData'@
349-- This parser is case sensitive and will not match @'showTextData'@
386−-- in presence of letters:
350+-- in presense of letters:
387--
351--
388-- >>> readTextData (showTextData True) :: Either Text Bool
352-- >>> readTextData (showTextData True) :: Either Text Bool
389-- Left "could not parse: `true'"
353-- Left "could not parse: `true'"
@@ -415,193 +379,79 @@ parseBounded reader input = do
415 l = toInteger (minBound :: a)
379 l = toInteger (minBound :: a)
416 h = toInteger (maxBound :: a)
380 h = toInteger (maxBound :: a)
417
381
418−-- | Convert to a URL-encoded path piece using 'toUrlPiece'.
419−-- /Note/: this function does not check if the result contains unescaped characters!
420−-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation
421−-- when the resulting URL piece /never/ has to be escaped.
422−unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder
423−unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece
424−
425-- |
382-- |
426-- >>> toUrlPiece ()
383-- >>> toUrlPiece ()
427-- "_"
384-- "_"
428instance ToHttpApiData () where
385instance ToHttpApiData () where
429 toUrlPiece () = "_"
386 toUrlPiece () = "_"
430− toEncodedUrlPiece = unsafeToEncodedUrlPiece
431
387
432−instance ToHttpApiData Char where
388+instance ToHttpApiData Char where toUrlPiece = T.singleton
433− toUrlPiece = T.singleton
434
389
435-- |
390-- |
436-- >>> toUrlPiece (Version [1, 2, 3] [])
391-- >>> toUrlPiece (Version [1, 2, 3] [])
437-- "1.2.3"
392-- "1.2.3"
438instance ToHttpApiData Version where
393instance ToHttpApiData Version where
439 toUrlPiece = T.pack . showVersion
394 toUrlPiece = T.pack . showVersion
440− toEncodedUrlPiece = unsafeToEncodedUrlPiece
441
395
396+#if MIN_VERSION_base(4,8,0)
442instance ToHttpApiData Void where toUrlPiece = absurd
397instance ToHttpApiData Void where toUrlPiece = absurd
443−instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
398+instance ToHttpApiData Natural where toUrlPiece = showt
444−
399+#endif
400+
445−instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
401+instance ToHttpApiData Bool where toUrlPiece = showTextData
446−instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
402+instance ToHttpApiData Ordering where toUrlPiece = showTextData
447−
403+
448−instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
404+instance ToHttpApiData Double where toUrlPiece = showt
449−instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
405+instance ToHttpApiData Float where toUrlPiece = showt
450−instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
406+instance ToHttpApiData Int where toUrlPiece = showt
451−instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
407+instance ToHttpApiData Int8 where toUrlPiece = showt
452−instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
408+instance ToHttpApiData Int16 where toUrlPiece = showt
453−instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
409+instance ToHttpApiData Int32 where toUrlPiece = showt
454−instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
410+instance ToHttpApiData Int64 where toUrlPiece = showt
455−instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
411+instance ToHttpApiData Integer where toUrlPiece = showt
456−instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
412+instance ToHttpApiData Word where toUrlPiece = showt
457−instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
413+instance ToHttpApiData Word8 where toUrlPiece = showt
458−instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
414+instance ToHttpApiData Word16 where toUrlPiece = showt
459−instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
415+instance ToHttpApiData Word32 where toUrlPiece = showt
460−instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
416+instance ToHttpApiData Word64 where toUrlPiece = showt
461−
462−-- | Note: this instance is not polykinded
463−instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
464
417
465-- |
418-- |
466-- >>> toUrlPiece (fromGregorian 2015 10 03)
419-- >>> toUrlPiece (fromGregorian 2015 10 03)
467-- "2015-10-03"
420-- "2015-10-03"
468−instance ToHttpApiData Day where
421+instance ToHttpApiData Day where toUrlPiece = T.pack . show
469− toUrlPiece = T.pack . show
470− toEncodedUrlPiece = unsafeToEncodedUrlPiece
471
422
472timeToUrlPiece :: FormatTime t => String -> t -> Text
423timeToUrlPiece :: FormatTime t => String -> t -> Text
473timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
424timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
474
425
475-- |
426-- |
476−-- >>> toUrlPiece $ TimeOfDay 14 55 23.1
477−-- "14:55:23.1"
478−instance ToHttpApiData TimeOfDay where
479− toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"
480− toEncodedUrlPiece = unsafeToEncodedUrlPiece
481−
482−-- |
483−-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687)
427+-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)
484−-- "2015-10-03T14:55:21.687"
428+-- "2015-10-03T14:55:01"
485−instance ToHttpApiData LocalTime where
429+instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"
486− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"
487− toEncodedUrlPiece = unsafeToEncodedUrlPiece
488
430
489-- |
431-- |
490−-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc
432+-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc
491−-- "2015-10-03T14:55:51.001+0000"
433+-- "2015-10-03T14:55:01+0000"
492−instance ToHttpApiData ZonedTime where
434+instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"
493− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"
494− toEncodedUrlPiece = unsafeToEncodedUrlPiece
495
435
496-- |
436-- |
497−-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5
437+-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864
498−-- "2015-10-03T00:14:24.5Z"
438+-- "2015-10-03T00:14:24Z"
499−instance ToHttpApiData UTCTime where
439+instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"
500− toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
501− toEncodedUrlPiece = unsafeToEncodedUrlPiece
502
440
503−-- |
441+instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
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−
554−instance ToHttpApiData NominalDiffTime where
555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
556− toEncodedUrlPiece = unsafeToEncodedUrlPiece
557
442
558instance ToHttpApiData String where toUrlPiece = T.pack
443instance ToHttpApiData String where toUrlPiece = T.pack
559instance ToHttpApiData Text where toUrlPiece = id
444instance ToHttpApiData Text where toUrlPiece = id
560instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
445instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
561
446
562−instance ToHttpApiData All where
447+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
563− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
564− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
565−
566−instance ToHttpApiData Any where
448+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
567− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
568− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
569−
570−instance ToHttpApiData a => ToHttpApiData (Dual a) where
571− toUrlPiece = coerce (toUrlPiece :: a -> Text)
572− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
573−
574−instance ToHttpApiData a => ToHttpApiData (Sum a) where
575− toUrlPiece = coerce (toUrlPiece :: a -> Text)
576− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
577
449
578−instance ToHttpApiData a => ToHttpApiData (Product a) where
450+instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual
579− toUrlPiece = coerce (toUrlPiece :: a -> Text)
451+instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum
580− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
452+instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct
581−
582−instance ToHttpApiData a => ToHttpApiData (First a) where
453+instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst
583− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
584− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
585−
586−instance ToHttpApiData a => ToHttpApiData (Last a) where
587− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
588− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
589−
590−instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where
591− toUrlPiece = coerce (toUrlPiece :: a -> Text)
592− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
593−
594−instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where
454+instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast
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)
605
455
606-- |
456-- |
607-- >>> toUrlPiece (Just "Hello")
457-- >>> toUrlPiece (Just "Hello")
@@ -619,41 +469,6 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
619 toUrlPiece (Left x) = "left " <> toUrlPiece x
469 toUrlPiece (Left x) = "left " <> toUrlPiece x
620 toUrlPiece (Right x) = "right " <> toUrlPiece x
470 toUrlPiece (Right x) = "right " <> toUrlPiece x
621
471
622−-- | /Note:/ this instance works correctly for alphanumeric name and value
623−--
624−-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
625−-- >>> toUrlPiece c
626−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"
627−--
628−-- >>> toHeader c
629−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"
630−--
631−instance ToHttpApiData SetCookie where
632− toUrlPiece = decodeUtf8With lenientDecode . toHeader
633− toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
634− -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
635−
636−-- | Note: this instance is not polykinded
637−instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where
638− toUrlPiece = coerce (toUrlPiece :: a -> Text)
639− toHeader = coerce (toHeader :: a -> ByteString)
640− toQueryParam = coerce (toQueryParam :: a -> Text)
641− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
642−
643−-- | @since 0.4.2
644−instance ToHttpApiData a => ToHttpApiData (Const a b) where
645− toUrlPiece = coerce (toUrlPiece :: a -> Text)
646− toHeader = coerce (toHeader :: a -> ByteString)
647− toQueryParam = coerce (toQueryParam :: a -> Text)
648− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
649−
650−-- | @since 0.4.2
651−instance ToHttpApiData a => ToHttpApiData (Identity a) where
652− toUrlPiece = coerce (toUrlPiece :: a -> Text)
653− toHeader = coerce (toHeader :: a -> ByteString)
654− toQueryParam = coerce (toQueryParam :: a -> Text)
655− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
656−
657-- |
472-- |
658-- >>> parseUrlPiece "_" :: Either Text ()
473-- >>> parseUrlPiece "_" :: Either Text ()
659-- Right ()
474-- Right ()
@@ -665,7 +480,7 @@ instance FromHttpApiData Char where
665 parseUrlPiece s =
480 parseUrlPiece s =
666 case T.uncons s of
481 case T.uncons s of
667 Just (c, s') | T.null s' -> pure c
482 Just (c, s') | T.null s' -> pure c
668− _ -> defaultParseError s
483+ _ -> defaultParseError s
669
484
670-- |
485-- |
671-- >>> showVersion <$> parseUrlPiece "1.2.3"
486-- >>> showVersion <$> parseUrlPiece "1.2.3"
@@ -676,6 +491,7 @@ instance FromHttpApiData Version where
676 ((x, ""):_) -> pure x
491 ((x, ""):_) -> pure x
677 _ -> defaultParseError s
492 _ -> defaultParseError s
678
493
494+#if MIN_VERSION_base(4,8,0)
679-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
495-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
680instance FromHttpApiData Void where
496instance FromHttpApiData Void where
681 parseUrlPiece _ = Left "Void cannot be parsed!"
497 parseUrlPiece _ = Left "Void cannot be parsed!"
@@ -684,8 +500,9 @@ instance FromHttpApiData Natural where
684 parseUrlPiece s = do
500 parseUrlPiece s = do
685 n <- runReader (signed decimal) s
501 n <- runReader (signed decimal) s
686 if n < 0
502 if n < 0
687− then Left ("underflow: " <> s <> " (should be a non-negative integer)")
503+ then Left ("undeflow: " <> s <> " (should be a non-negative integer)")
688 else Right (fromInteger n)
504 else Right (fromInteger n)
505+#endif
689
506
690instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
507instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
691instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
508instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
@@ -706,89 +523,41 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706instance FromHttpApiData Text where parseUrlPiece = Right
523instance FromHttpApiData Text where parseUrlPiece = Right
707instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
524instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
708
525
709−-- | Note: this instance is not polykinded
710−instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where
711− parseUrlPiece = runReader rational
712−
713-- |
526-- |
714-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
527-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
715-- Right (2016,12,1)
528-- Right (2016,12,1)
716−instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day
529+instance FromHttpApiData Day where parseUrlPiece = readTextData
717
530
718−-- |
531+timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t
719−-- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay
532+timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack)
720−-- Right 14:55:01.333
533+ where
721−instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay
534+ timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt))
722
535
723-- |
536-- |
724-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
537-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
725-- Right 2015-10-03 14:55:01
538-- Right 2015-10-03 14:55:01
726−instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime
539+instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S"
727
540
728-- |
541-- |
729-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
542-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
730-- Right 2015-10-03 14:55:01 +0000
543-- Right 2015-10-03 14:55:01 +0000
731−--
732−-- >>> parseQueryParam "2016-12-31T01:00:00Z" :: Either Text ZonedTime
733−-- Right 2016-12-31 01:00:00 +0000
734−instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
544+instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z"
735
545
736-- |
546-- |
737-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
547-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
738-- Right 2015-10-03 00:14:24 UTC
548-- Right 2015-10-03 00:14:24 UTC
739−instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
549+instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ"
740
550
741−-- |
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
743−-- Right Monday
744−instance FromHttpApiData DayOfWeek where
551+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece
745− parseUrlPiece t = case Map.lookup (T.toLower t) m of
746− Just dow -> Right dow
747− Nothing -> Left $ "Incorrect DayOfWeek: " <> T.take 10 t
748− where
749− m :: Map.Map Text DayOfWeek
750− m = Map.fromList [ (toUrlPiece dow, dow) | dow <- [Monday .. Sunday] ]
751
552
553+instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
554+instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
752
555
753−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
754−
755−-- |
756−-- >>> parseUrlPiece "2021-01" :: Either Text Month
757−-- Right 2021-01
758−instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month
759−
760−-- |
761−-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter
762−-- Right 2021-Q1
763−instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter
764−
765−-- |
766−-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear
767−-- Right Q2
768−--
769−-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear
770−-- Right Q3
771−instance FromHttpApiData QuarterOfYear where
772− parseUrlPiece t = case T.toLower t of
773− "q1" -> return Q1
774− "q2" -> return Q2
775− "q3" -> return Q3
776− "q4" -> return Q4
777− _ -> Left "Invalid quarter of year"
778−
779−instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
780−instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
781−
782−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
783−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
556+instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
784−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
557+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
785−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
558+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
786−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
787−
788−instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
789−instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
559+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
790−instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
791−instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
560+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
792
561
793-- |
562-- |
794-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
563-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
@@ -813,55 +582,7 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)
813instance ToHttpApiData UUID.UUID where
582instance ToHttpApiData UUID.UUID where
814 toUrlPiece = UUID.toText
583 toUrlPiece = UUID.toText
815 toHeader = UUID.toASCIIBytes
584 toHeader = UUID.toASCIIBytes
816− toEncodedUrlPiece = unsafeToEncodedUrlPiece
817
585
818instance FromHttpApiData UUID.UUID where
586instance FromHttpApiData UUID.UUID where
819 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
587 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
820 parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
588 parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
821−
822−
823−-- | Lenient parameters. 'FromHttpApiData' combinators always return `Right`.
824−--
825−-- @since 0.3.5
826−newtype LenientData a = LenientData { getLenientData :: Either Text a }
827− deriving (Eq, Ord, Show, Read, Typeable, Data, Functor, Foldable, Traversable)
828−
829−instance FromHttpApiData a => FromHttpApiData (LenientData a) where
830− parseUrlPiece = Right . LenientData . parseUrlPiece
831− parseHeader = Right . LenientData . parseHeader
832− parseQueryParam = Right . LenientData . parseQueryParam
833−
834−-- | /Note:/ this instance works correctly for alphanumeric name and value
835−--
836−-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
837−-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing})
838−instance FromHttpApiData SetCookie where
839− parseUrlPiece = parseHeader . encodeUtf8
840− parseHeader = Right . parseSetCookie
841−
842−-- | Note: this instance is not polykinded
843−instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where
844− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
845− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
846− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
847−
848−-- | @since 0.4.2
849−instance FromHttpApiData a => FromHttpApiData (Const a b) where
850− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
851− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
852− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
853−
854−-- | @since 0.4.2
855−instance FromHttpApiData a => FromHttpApiData (Identity a) where
856− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
857− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
858− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
859−
860−-------------------------------------------------------------------------------
861−-- Attoparsec helpers
862−-------------------------------------------------------------------------------
863−
864−runAtto :: Atto.Parser a -> Text -> Either Text a
865−runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
866− Left err -> Left (T.pack err)
867− Right x -> Right x
stack-ghc-7.10.yamlnew file+12
@@ -0,0 +1,12 @@
1+resolver: lts-6.8
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-2016-07-19
2+
2packages:
3packages:
3- '.'
4- '.'
5+
4flags:
6flags:
5 http-api-data:
7 http-api-data:
6 use-text-show: false
8 use-text-show: false
9+
10+extra-deps:
11+- QuickCheck-2.9.2
12+extra-package-dbs: []
test/DocTest.hsnew file+31
@@ -0,0 +1,31 @@
1+module Main where
2+
3+import Build_doctest (autogen_dir, deps)
4+import Control.Applicative
5+import Control.Monad
6+import Data.List
7+import System.Directory
8+import System.FilePath
9+import Test.DocTest
10+
11+main :: IO ()
12+main = getSources >>= \sources -> doctest $
13+ "-isrc"
14+ : "-Iinclude"
15+ : ("-i" ++ autogen_dir)
16+ : "-optP-include"
17+ : ("-optP" ++ autogen_dir ++ "/cabal_macros.h")
18+ : "-hide-all-packages"
19+ : map ("-package="++) deps ++ sources
20+
21+getSources :: IO [FilePath]
22+getSources = filter (isSuffixOf ".hs") <$> go "src"
23+ where
24+ go dir = do
25+ (dirs, files) <- getFilesAndDirectories dir
26+ (files ++) . concat <$> mapM go dirs
27+
28+getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
29+getFilesAndDirectories dir = do
30+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
31+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
test/Web/Internal/HttpApiDataSpec.hs+51−71
@@ -1,61 +1,40 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
2module Web.Internal.HttpApiDataSpec (spec) where
3module Web.Internal.HttpApiDataSpec (spec) where
3
4
5+import Control.Applicative
6+import Data.Int
7+import Data.Word
8+import Data.Time
9+import qualified Data.Text as T
10+import qualified Data.Text.Lazy as L
11+import qualified Data.ByteString as BS
12+import Data.Version
13+import qualified Data.UUID as UUID
4
14
5−import Prelude ()
15+import Data.Proxy
6−import Prelude.Compat
7
16
8−import qualified Data.ByteString as BS
17+#if MIN_VERSION_base(4,8,0)
9−import Data.ByteString.Builder (toLazyByteString)
18+import Numeric.Natural
10−import Data.Char
19+#endif
11−import qualified Data.Fixed as F
12−import Data.Int
13−import qualified Data.Text as T
14−import qualified Data.Text.Encoding as TE
15−import qualified Data.Text.Lazy as L
16−import Data.Time.Compat
17−import Data.Time.Calendar.Month.Compat (Month)
18−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
19−import qualified Data.UUID.Types as UUID
20−import Data.Version
21−import Data.Word
22−import Web.Cookie (SetCookie, defaultSetCookie,
23− setCookieName, setCookieValue)
24
20
25−import Data.Proxy
21+import Test.Hspec
22+import Test.Hspec.QuickCheck(prop)
23+import Test.QuickCheck
26
24
27−import Numeric.Natural
25+import Web.Internal.HttpApiData
28
26
29−import Test.Hspec
27+import Web.Internal.TestInstances
30−import Test.Hspec.QuickCheck (prop)
31−import Test.QuickCheck
32
28
33−import Web.Internal.HttpApiData
29+(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
30+(f <=> g) x = g (f x) == Right x
34
31
35−import Web.Internal.TestInstances
36−
37−(<=>) :: forall a b. (Show a, Show b, Eq a) => (a -> b) -> (b -> Either T.Text a) -> a -> Property
38−(f <=> g) x = counterexample
39− (show lhs' ++ " : " ++ show lhs ++ " /= " ++ show rhs)
40− (lhs == rhs)
41− where
42− lhs' = f x
43− lhs = g lhs' :: Either T.Text a
44− rhs = Right x :: Either T.Text a
45−
46−encodedUrlPieceProp :: ToHttpApiData a => a -> Property
47−encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x)
48−
49−-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility
50checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
32checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
51−checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a)
33+checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
52
34
35+-- | Check with given generator
53checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec
36checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec
54−checkUrlPiece' gen name = describe name $ do
37+checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)
55− prop "toUrlPiece <=> parseUrlPiece" $ forAll gen (toUrlPiece <=> parseUrlPiece :: a -> Property)
56− prop "toQueryParam <=> parseQueryParam" $ forAll gen (toQueryParam <=> parseQueryParam :: a -> Property)
57− prop "toHeader <=> parseHeader" $ forAll gen (toHeader <=> parseHeader :: a -> Property)
58− prop "toEncodedUrlPiece encodes correctly" $ forAll gen encodedUrlPieceProp
59
38
60-- | Check case insensitivity for @parseUrlPiece@.
39-- | Check case insensitivity for @parseUrlPiece@.
61checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
40checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
@@ -63,7 +42,7 @@ checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
63
42
64spec :: Spec
43spec :: Spec
65spec = do
44spec = do
66− describe "Instances" $ do
45+ describe "toUrlPiece <=> parseUrlPiece" $ do
67 checkUrlPiece (Proxy :: Proxy ()) "()"
46 checkUrlPiece (Proxy :: Proxy ()) "()"
68 checkUrlPiece (Proxy :: Proxy Char) "Char"
47 checkUrlPiece (Proxy :: Proxy Char) "Char"
69 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
48 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
@@ -83,34 +62,21 @@ spec = do
83 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
62 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
84 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
63 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
85 checkUrlPiece (Proxy :: Proxy Day) "Day"
64 checkUrlPiece (Proxy :: Proxy Day) "Day"
86− checkUrlPiece (Proxy :: Proxy TimeOfDay) "TimeOfDay"
65+ checkUrlPiece' localTimeGen "LocalTime"
87− checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"
88− checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"
66+ checkUrlPiece' zonedTimeGen "ZonedTime"
89− checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
67+ checkUrlPiece' utcTimeGen "UTCTime"
90− checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
68+ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"
91− checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"
92− checkUrlPiece (Proxy :: Proxy Quarter) "Quarter"
93− checkUrlPiece (Proxy :: Proxy QuarterOfYear) "QuarterOfYear"
94− checkUrlPiece (Proxy :: Proxy Month) "Month"
95− checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"
96 checkUrlPiece (Proxy :: Proxy Version) "Version"
69 checkUrlPiece (Proxy :: Proxy Version) "Version"
97− checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID"
70+ checkUrlPiece' uuidGen "UUID"
98− checkUrlPiece' setCookieGen "Cookie"
99−
100− checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"
101− checkUrlPiece (Proxy :: Proxy F.Deci) "Deci"
102− checkUrlPiece (Proxy :: Proxy F.Centi) "Centi"
103− checkUrlPiece (Proxy :: Proxy F.Milli) "Milli"
104− checkUrlPiece (Proxy :: Proxy F.Micro) "Micro"
105− checkUrlPiece (Proxy :: Proxy F.Nano) "Nano"
106− checkUrlPiece (Proxy :: Proxy F.Pico) "Pico"
107
71
108 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
72 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
109 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
73 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
110 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
74 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
111 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
75 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
112
76
77+#if MIN_VERSION_base(4,8,0)
113 checkUrlPiece (Proxy :: Proxy Natural) "Natural"
78 checkUrlPiece (Proxy :: Proxy Natural) "Natural"
79+#endif
114
80
115 it "bad integers are rejected" $ do
81 it "bad integers are rejected" $ do
116 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
82 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
@@ -122,8 +88,22 @@ spec = do
122 it "invalid utf8 is handled" $ do
88 it "invalid utf8 is handled" $ do
123 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
89 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
124
90
125−setCookieGen :: Gen SetCookie
91+uuidGen :: Gen UUID.UUID
126−setCookieGen = do
92+uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
127− n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary
93+
128− v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary
94+-- TODO: this generators don't generate full range items
129− return $ defaultSetCookie { setCookieName = n, setCookieValue = v }
95+localTimeGen :: Gen LocalTime
96+localTimeGen = LocalTime
97+ <$> arbitrary
98+ <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
99+
100+zonedTimeGen :: Gen ZonedTime
101+zonedTimeGen = ZonedTime
102+ <$> localTimeGen -- Note: not arbitrary!
103+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
104+
105+utcTimeGen :: Gen UTCTime
106+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
107+
108+nominalDiffTimeGen :: Gen NominalDiffTime
109+nominalDiffTimeGen = fromInteger <$> arbitrary
test/Web/Internal/TestInstances.hs+1−1
@@ -12,7 +12,7 @@ import Control.Applicative
12import Data.Char
12import Data.Char
13import qualified Data.HashMap.Strict as HashMap
13import qualified Data.HashMap.Strict as HashMap
14import qualified Data.Text as T
14import qualified Data.Text as T
15−import Data.Time.Compat
15+import Data.Time
16import GHC.Exts (fromList)
16import GHC.Exts (fromList)
17import GHC.Generics
17import GHC.Generics
18
18