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

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

.ghcideleted−1

since splitsnapshots

@@ -1 +0,0 @@

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.ymlnew file+283

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

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

1/dist/

2+/dist-newstyle/

3+/.ghc.environment.*

2/.shelly/

4/.shelly/

3/tarballs/

5/tarballs/

4*.swp

6*.swp

.travis.ymldeleted−35

@@ -1,35 +0,0 @@

1−sudo: false

2−

3−addons:

4− apt:

5− sources:

6− - hvr-ghc

7− packages:

8− - happy-1.19.5

9− - libgmp-dev

10−

11−env:

12− - STACK_YAML=stack.yaml FLAGS="--flag http-api-data:use-text-show"

13− - STACK_YAML=stack-ghc-7.8.yaml FLAGS="--flag http-api-data:use-text-show"

14− - STACK_YAML=stack-ghc-7.10.yaml FLAGS="--flag http-api-data:use-text-show"

15− - STACK_YAML=stack.yaml FLAGS=

16− - STACK_YAML=stack-ghc-7.8.yaml FLAGS=

17− - STACK_YAML=stack-ghc-7.10.yaml FLAGS=

18−

19−before_install:

20− # Download and unpack the stack executable

21− - mkdir -p ~/.local/bin

22− - export PATH=$HOME/.local/bin:/opt/happy/1.19.5/bin:$PATH

23− - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'

24− - export PATH=~/.local/bin:$PATH

25− - stack --version

26−

27−install:

28− - stack setup

29−

30−script:

31− - stack --no-terminal build --test $FLAGS

32−

33−cache:

34− directories:

35− - $HOME/.stack

CHANGELOG.md+128

@@ -1,3 +1,131 @@

1+0.5

2+---

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.

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+

110+0.3.3

111+---

112+

113+* Minor changes:

114+ * Expose `Form` constructor from `Web.FromUrlEncoded` (see [#40](https://github.com/fizruk/http-api-data/pull/40));

115+ * Fix example in `FromForm` documentation (see [#39](https://github.com/fizruk/http-api-data/issues/39)).

116+

117+0.3.2

118+---

119+

120+* Minor change:

121+ * Export `Form` type from `Web.FormUrlEncoded` (see [#37](https://github.com/fizruk/http-api-data/pull/37)).

122+

123+0.3.1

124+---

125+

126+* Minor changes:

127+ * Add instances for `Data.UUID` (see [#34](https://github.com/fizruk/http-api-data/pull/34)).

128+

10.3

1290.3

2---

130---

3* Major changes:

131* Major changes:

Setup.hsnew file+2

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

1+import Distribution.Simple

2+main = defaultMain

Setup.lhsdeleted−48

@@ -1,48 +0,0 @@

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-cinew file+6

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

1+branches: master

2+doctest: <9

3+doctest-filter-packages: base-compat

5+constraint-set text-show

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

cabal.projectnew file+2

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

1+packages: .

2+tests: True

http-api-data.cabal+63−34

@@ -1,41 +1,72 @@

1+cabal-version: >= 1.10

1name: http-api-data

2name: http-api-data

2−version: 0.3

3+version: 0.5

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+

3license: BSD3

12license: BSD3

4license-file: LICENSE

13license-file: LICENSE

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

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

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

15maintainer: 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

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

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

10−category: Web

11stability: unstable

17stability: unstable

12−cabal-version: >= 1.10

13−build-type: Custom

18+build-type: Simple

19+

14extra-source-files:

20extra-source-files:

15 include/overlapping-compat.h

21 include/overlapping-compat.h

16 test/*.hs

22 test/*.hs

17 CHANGELOG.md

23 CHANGELOG.md

18 README.md

24 README.md

26+tested-with:

27+ GHC==8.0.2,

28+ GHC==8.2.2,

29+ GHC==8.4.4,

30+ GHC==8.6.5,

31+ GHC==8.8.4,

32+ GHC==8.10.7,

33+ GHC==9.0.2,

34+ GHC==9.2.3,

35+ GHC==9.4.1

36+

20flag use-text-show

37flag use-text-show

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

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

22 default: False

39 default: False

40+ manual: True

24library

42library

25 hs-source-dirs: src/

43 hs-source-dirs: src/

26 include-dirs: include/

44 include-dirs: include/

45+

46+ -- GHC bundled

27− build-depends: base >= 4.6 && < 4.10

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

28− , bytestring

48+ , bytestring >= 0.10.8.1 && < 0.12

29− , containers

49+ , containers >= 0.5.7.1 && < 0.7

30− , hashable

31− , text >= 0.5

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

32− , time

51+ , transformers >= 0.5.2.0 && < 0.7

33− , time-locale-compat >=0.1.1.0 && <0.2

52+

53+ -- other-dependencies

54+ build-depends:

55+ attoparsec >= 0.13.2.2 && < 0.15

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

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

58+ , cookie >= 0.4.3 && < 0.5

59+ , hashable >= 1.2.7.0 && < 1.5

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

61+ , tagged >= 0.8.5 && < 0.9

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

34− , unordered-containers

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

35− , uri-bytestring

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

65+

36 if flag(use-text-show)

66 if flag(use-text-show)

37 cpp-options: -DUSE_TEXT_SHOW

67 cpp-options: -DUSE_TEXT_SHOW

38− build-depends: text-show >= 2

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

69+

39 exposed-modules:

70 exposed-modules:

40 Web.HttpApiData

71 Web.HttpApiData

41 Web.FormUrlEncoded

72 Web.FormUrlEncoded

@@ -54,28 +85,26 @@ test-suite spec

54 hs-source-dirs: test

85 hs-source-dirs: test

55 ghc-options: -Wall

86 ghc-options: -Wall

56 default-language: Haskell2010

87 default-language: Haskell2010

57− build-depends: HUnit

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

58− , hspec >= 1.3

89+ -- inherited depndencies

59− , base >= 4 && < 5

90+ build-depends:

91+ base

92+ , base-compat

60 , bytestring

93 , bytestring

61− , QuickCheck

94+ , cookie

62− , unordered-containers

63 , http-api-data

95 , http-api-data

64 , text

96 , text

65− , time

97+ , time-compat

66− , bytestring

98+ , unordered-containers

99+ , uuid-types

100+

101+ if !impl(ghc >= 7.10)

102+ build-depends: nats

103

68−test-suite doctest

69− ghc-options: -Wall

70− build-depends:

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

71− base,

105+ , hspec >= 2.7.1 && <2.11

72− directory >= 1.0,

106+ , QuickCheck >= 2.13.1 && <2.15

73− doctest >= 0.11 && <0.12,

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

74− filepath

75− default-language: Haskell2010

76− hs-source-dirs: test

77− main-is: DocTest.hs

78− type: exitcode-stdio-1.0

108

80source-repository head

109source-repository head

81 type: git

110 type: git

src/Web/FormUrlEncoded.hs+11−1

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

9 ToFormKey(..),

10 FromFormKey(..),

12+ -- * 'Form' type

13+ Form(..),

14+

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

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

13 urlEncodeAsForm,

16 urlEncodeAsForm,

17+ urlEncodeAsFormStable,

14 urlDecodeAsForm,

18 urlDecodeAsForm,

16 urlEncodeForm,

20 urlEncodeForm,

21+ urlEncodeFormStable,

17 urlDecodeForm,

22 urlDecodeForm,

19 -- * 'Generic's

24 -- * 'Generic's

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

25 defaultFormOptions,

30 defaultFormOptions,

27 -- * Helpers

32 -- * Helpers

33+ toListStable,

28 toEntriesByKey,

34 toEntriesByKey,

35+ toEntriesByKeyStable,

29 fromEntriesByKey,

36 fromEntriesByKey,

31 lookupAll,

38 lookupAll,

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

35 parseAll,

42 parseAll,

36 parseMaybe,

43 parseMaybe,

37 parseUnique,

44 parseUnique,

45+

46+ urlEncodeParams,

47+ urlDecodeParams,

38) where

48) where

40−import Web.Internal.FormUrlEncoded

50+import Web.Internal.FormUrlEncoded

src/Web/HttpApiData.hs+5−3

@@ -35,21 +35,23 @@ module Web.HttpApiData (

35 parseBoundedEnumOfI,

36 parseBoundedTextData,

38+ -- * Lenient data

39+ LenientData (..),

40+

38 -- * Other helpers

41 -- * Other helpers

39 showTextData,

42 showTextData,

40 readTextData,

43 readTextData,

41) where

44) where

43−import Web.Internal.HttpApiData

46+import Web.Internal.HttpApiData

45-- $setup

48-- $setup

46--

49--

47-- >>> :set -XOverloadedStrings

50-- >>> :set -XOverloadedStrings

48-- >>> import Control.Applicative

51-- >>> import Control.Applicative

49−-- >>> import Data.Time

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

50-- >>> import Data.Int

53-- >>> import Data.Int

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

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

52−-- >>> import Data.Time (Day)

53-- >>> import Data.Version

55-- >>> import Data.Version

55-- $examples

57-- $examples

src/Web/Internal/FormUrlEncoded.hs+144−62

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

17#include "overlapping-compat.h"

18module Web.Internal.FormUrlEncoded where

20−#if __GLASGOW_HASKELL__ < 710

20+import Prelude ()

21−import Control.Applicative

21+import Prelude.Compat

22−import Data.Traversable

23−#endif

24−

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

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

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

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

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

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

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

29import qualified Data.ByteString.Lazy as BSL

27import qualified Data.ByteString.Lazy as BSL

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

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

29+import Data.Coerce (coerce)

31import qualified Data.Foldable as F

30import qualified Data.Foldable as F

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

32import Data.Hashable (Hashable)

33import Data.HashMap.Strict (HashMap)

34import qualified Data.HashMap.Strict as HashMap

35−import Data.Int

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

36import Data.IntMap (IntMap)

37import qualified Data.IntMap as IntMap

38−import Data.List (intersperse)

38+import Data.List (intersperse, sortBy)

39import Data.Map (Map)

40import qualified Data.Map as Map

41−import Data.Monoid

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

42−

42+ Product (..), Sum (..))

43+import Data.Ord (comparing)

44+import Data.Proxy (Proxy (..))

45+import Data.Semigroup (Semigroup (..))

46+import qualified Data.Semigroup as Semi

47+import Data.Tagged (Tagged (..))

43import Data.Text (Text)

48import Data.Text (Text)

44import qualified Data.Text as Text

49import qualified Data.Text as Text

45−import qualified Data.Text.Lazy as Lazy

50+import qualified Data.Text.Encoding as Text

46−import Data.Text.Encoding as Text

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

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

48−

52+import qualified Data.Text.Lazy as Lazy

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

54+ UTCTime, ZonedTime)

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

49−import Data.Time

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

50−import Data.Proxy

57+import Data.Void (Void)

51−import Data.Word

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

52−

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

54−import Data.Void

55−import Numeric.Natural

56−#endif

57−

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

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

59import GHC.Generics

60import GHC.Generics

60import GHC.TypeLits

61import GHC.TypeLits

61−import URI.ByteString (urlEncodeQuery, urlDecodeQuery)

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

62−

63+import Numeric.Natural (Natural)

63−import Web.Internal.HttpApiData

64+import Web.Internal.HttpApiData

65-- $setup

66-- $setup

66-- >>> :set -XDeriveGeneric

67-- >>> :set -XDeriveGeneric

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

114instance ToFormKey ZonedTime where toFormKey = toQueryParam

115instance ToFormKey ZonedTime where toFormKey = toQueryParam

115instance ToFormKey UTCTime where toFormKey = toQueryParam

116instance ToFormKey UTCTime where toFormKey = toQueryParam

116instance ToFormKey NominalDiffTime where toFormKey = toQueryParam

117instance 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

117

121

118instance ToFormKey String where toFormKey = toQueryParam

122instance ToFormKey String where toFormKey = toQueryParam

119instance ToFormKey Text where toFormKey = toQueryParam

123instance ToFormKey Text where toFormKey = toQueryParam

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

122instance ToFormKey All where toFormKey = toQueryParam

126instance ToFormKey All where toFormKey = toQueryParam

123instance ToFormKey Any where toFormKey = toQueryParam

127instance ToFormKey Any where toFormKey = toQueryParam

124

128

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

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

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

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

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

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

132+

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

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

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

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

137+

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

139+

140+-- | @since 0.4.2

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

142+

143+-- | @since 0.4.2

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

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

128

146

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

130instance ToFormKey Void where toFormKey = toQueryParam

147instance ToFormKey Void where toFormKey = toQueryParam

131instance ToFormKey Natural where toFormKey = toQueryParam

148instance ToFormKey Natural where toFormKey = toQueryParam

132−#endif

133

149

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

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

135class FromFormKey k where

151class FromFormKey k where

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

161instance FromFormKey ZonedTime where parseFormKey = parseQueryParam

177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam

162instance FromFormKey UTCTime where parseFormKey = parseQueryParam

178instance FromFormKey UTCTime where parseFormKey = parseQueryParam

163instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam

179instance 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

164

183

165instance FromFormKey String where parseFormKey = parseQueryParam

184instance FromFormKey String where parseFormKey = parseQueryParam

166instance FromFormKey Text where parseFormKey = parseQueryParam

185instance FromFormKey Text where parseFormKey = parseQueryParam

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

169instance FromFormKey All where parseFormKey = parseQueryParam

188instance FromFormKey All where parseFormKey = parseQueryParam

170instance FromFormKey Any where parseFormKey = parseQueryParam

189instance FromFormKey Any where parseFormKey = parseQueryParam

171

190

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

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

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

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

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

194+

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

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

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

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

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

199+

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

201+

202+-- | @since 0.4.2

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

204+

205+-- | @since 0.4.2

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

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

175

208

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

177instance FromFormKey Void where parseFormKey = parseQueryParam

209instance FromFormKey Void where parseFormKey = parseQueryParam

178instance FromFormKey Natural where parseFormKey = parseQueryParam

210instance FromFormKey Natural where parseFormKey = parseQueryParam

179−#endif

180

211

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

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

182--

213--

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

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

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

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

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

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

186

217

187instance Show Form where

218instance Show Form where

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

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

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

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

190

221

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

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

191instance IsList Form where

224instance IsList Form where

192 type Item Form = (Text, Text)

225 type Item Form = (Text, Text)

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

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

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

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

195

228

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

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

231+toListStable = sortOn fst . toList

232+

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

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

197--

234--

198-- An example type and instance:

235-- An example type and instance:

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

303-- instance 'ToForm' Post

340-- instance 'ToForm' Post

304-- @

341-- @

305--

342--

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

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

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

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

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

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

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

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

@@ -355,9 +392,9 @@ instance NotSupported ToForm t "is a sum type" => GToForm t (f :+: g) where gToF

355-- , age :: Int }

392-- , age :: Int }

356--

393--

357-- instance 'FromForm' Person where

394-- instance 'FromForm' Person where

358−-- 'fromForm' (Form m) = Person

395+-- 'fromForm' f = Person

359−-- '<$>' 'parseUnique' "name" m

396+-- '<$>' 'parseUnique' "name" f

360−-- '<*>' 'parseUnique' "age" m

397+-- '<*>' 'parseUnique' "age" f

361-- @

398-- @

362--

399--

363-- Instead of manually writing @'FromForm'@ instances you can

400-- Instead of manually writing @'FromForm'@ instances you can

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

388

425

389instance FromForm Form where fromForm = pure

426instance FromForm Form where fromForm = pure

390

427

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

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

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

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

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

393

431

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

402

440

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

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

404--

442--

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

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

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

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

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

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

408toEntriesByKey = traverse parseGroup . HashMap.toList . unForm

446toEntriesByKey = traverse parseGroup . HashMap.toList . unForm

409 where

447 where

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

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

411

449

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+

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

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

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

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

414--

461--

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

482

529

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

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

484--

531--

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+--

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

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

486--

542--

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

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

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

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

489--

545--

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

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

491--

547--

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

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

493-- "is_test"

549-- "is_test"

494--

550--

495-- Empty keys are allowed too:

551-- Empty keys are allowed too:

496--

552--

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

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

498-- "=foobar"

554-- "=foobar"

499--

555--

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

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

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

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

502--

558--

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

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

504-- ""

560-- ""

505--

561--

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

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

507--

563--

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

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

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

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

510−urlEncodeForm :: Form -> BSL.ByteString

566+urlEncodeFormStable :: Form -> BSL.ByteString

567+urlEncodeFormStable = urlEncodeParams . sortOn fst . toList

568+

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

570+--

571+-- See also 'urlEncodeFormStable'.

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

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

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

512 where

574 where

513− escape = urlEncodeQuery . Text.encodeUtf8

575+ escape = urlEncodeBuilder True . Text.encodeUtf8

514

576

515 encodePair (k, "") = escape k

577 encodePair (k, "") = escape k

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

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

517−

518

579

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

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

520--

581--

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

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

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

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

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

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

611urlDecodeForm :: 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)]

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

618+urlDecodeParams bs = traverse parsePair pairs

552 where

619 where

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

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

554

621

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

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

556

623

557 parsePair p =

624 parsePair p =

558 case map unescape p of

625 case map unescape p of

@@ -560,6 +627,7 @@ urlDecodeForm bs = toForm <$> traverse parsePair pairs

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

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

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

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

562

629

630+

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

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

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

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

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

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

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

577--

645--

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

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

579--

647--

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

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

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

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

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

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

583urlEncodeAsForm = urlEncodeForm . toForm

651urlEncodeAsForm = urlEncodeForm . toForm

584

652

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+

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

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

586--

665--

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

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

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

692-- 'fromForm' = 'genericFromForm' myOptions

771-- 'fromForm' = 'genericFromForm' myOptions

693-- @

772-- @

694--

773--

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

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

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

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

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

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

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

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

699data FormOptions = FormOptions

778data FormOptions = FormOptions

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

712defaultFormOptions = FormOptions

791defaultFormOptions = FormOptions

713 { fieldLabelModifier = id

792 { fieldLabelModifier = id

714 }

793 }

794+

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

796+sortOn f = sortBy (comparing f)

src/Web/Internal/HttpApiData.hs+387−99

@@ -1,54 +1,86 @@

1−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DefaultSignatures #-}

2+{-# LANGUAGE DefaultSignatures #-}

3+{-# LANGUAGE DeriveDataTypeable #-}

4+{-# LANGUAGE DeriveFoldable #-}

5+{-# LANGUAGE DeriveFunctor #-}

6+{-# LANGUAGE DeriveTraversable #-}

3−{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE FlexibleInstances #-}

8+{-# LANGUAGE KindSignatures #-}

4−{-# LANGUAGE OverloadedStrings #-}

9+{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE PolyKinds #-}

5−{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE TypeSynonymInstances #-}

12{-# LANGUAGE TypeSynonymInstances #-}

7-- |

13-- |

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

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

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

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

10module Web.Internal.HttpApiData where

16module Web.Internal.HttpApiData where

12−#if __GLASGOW_HASKELL__ < 710

18+import Prelude ()

19+import Prelude.Compat

20+

13−import Control.Applicative

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

14−import Data.Traversable (Traversable(traverse))

15−#endif

16−

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

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

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

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

19−

24+import qualified Data.Attoparsec.Text as Atto

25+import qualified Data.Attoparsec.Time as Atto

26+import Data.ByteString (ByteString)

27+import qualified Data.ByteString as BS

28+import qualified Data.ByteString.Builder as BS

29+import qualified Data.ByteString.Lazy as LBS

30+import Data.Coerce (coerce)

31+import Data.Data (Data)

32+import qualified Data.Fixed as F

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

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

35+import Data.Kind (Type)

36+import qualified Data.Map as Map

20−import Data.Monoid

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

21−import Data.ByteString (ByteString)

38+ First (..), Last (..),

39+ Product (..), Sum (..))

40+import Data.Semigroup (Semigroup (..))

22−import qualified Data.ByteString as BS

41+import qualified Data.Semigroup as Semi

23−

24−import Data.Int

42+import Data.Tagged (Tagged (..))

25−import Data.Word

26−

27−import Data.Text (Text)

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,

29−import Data.Text.Read (signed, decimal, rational, Reader)

46+ encodeUtf8)

30−import qualified Data.Text as T

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

31−import qualified Data.Text.Lazy as L

48+import qualified Data.Text.Lazy as L

32−

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

33−import Data.Time.Locale.Compat

50+ signed)

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

52+ NominalDiffTime, TimeOfDay,

53+ UTCTime, ZonedTime, formatTime,

54+ DayOfWeek (..),

55+ nominalDiffTimeToSeconds,

56+ secondsToNominalDiffTime)

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

58+ iso8601DateFormat)

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

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

61+ toYearQuarter)

62+import Data.Typeable (Typeable)

34−import Data.Time

63+import qualified Data.UUID.Types as UUID

35−import Data.Version

64+import Data.Version (Version, parseVersion,

36−

65+ showVersion)

37−#if MIN_VERSION_base(4,8,0)

66+import Data.Void (Void, absurd)

38−import Data.Void

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

68+import qualified Network.HTTP.Types as H

39−import Numeric.Natural

69+import Numeric.Natural (Natural)

40−#endif

41−

42−import Text.Read (readMaybe)

43−import Text.ParserCombinators.ReadP (readP_to_S)

70+import Text.ParserCombinators.ReadP (readP_to_S)

71+import Text.Read (readMaybe)

72+import Web.Cookie (SetCookie, parseSetCookie,

73+ renderSetCookie)

45#if USE_TEXT_SHOW

75#if USE_TEXT_SHOW

46−import TextShow (TextShow, showt)

76+import TextShow (TextShow, showt)

47#endif

77#endif

49-- $setup

79-- $setup

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

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

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

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

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

83+-- >>> import Data.Version

53-- | Convert value to HTTP API data.

85-- | Convert value to HTTP API data.

54--

86--

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

60 toUrlPiece :: a -> Text

92 toUrlPiece :: a -> Text

61 toUrlPiece = toQueryParam

93 toUrlPiece = toQueryParam

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

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

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

98+ toEncodedUrlPiece :: a -> BS.Builder

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

100+

63 -- | Convert to HTTP header value.

101 -- | Convert to HTTP header value.

64 toHeader :: a -> ByteString

102 toHeader :: a -> ByteString

65 toHeader = encodeUtf8 . toUrlPiece

103 toHeader = encodeUtf8 . toUrlPiece

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

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

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

301-- Right True

339-- Right True

302--

340--

303−-- For case sensitive parser see 'parseBoundedEnumOfI'.

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

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

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

305parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf

343parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf

306

344

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

345-- Right 1991-06-02

383-- Right 1991-06-02

346--

384--

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

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

348−-- in presense of letters:

386+-- in presence of letters:

349--

387--

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

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

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

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

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

377 l = toInteger (minBound :: a)

415 l = toInteger (minBound :: a)

378 h = toInteger (maxBound :: a)

416 h = toInteger (maxBound :: a)

379

417

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+

380-- |

425-- |

381-- >>> toUrlPiece ()

426-- >>> toUrlPiece ()

382-- "_"

427-- "_"

383instance ToHttpApiData () where

428instance ToHttpApiData () where

384 toUrlPiece () = "_"

429 toUrlPiece () = "_"

430+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

385

431

386−instance ToHttpApiData Char where toUrlPiece = T.singleton

432+instance ToHttpApiData Char where

433+ toUrlPiece = T.singleton

387

434

388-- |

435-- |

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

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

390-- "1.2.3"

437-- "1.2.3"

391instance ToHttpApiData Version where

438instance ToHttpApiData Version where

392 toUrlPiece = T.pack . showVersion

439 toUrlPiece = T.pack . showVersion

440+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

393

441

394−#if MIN_VERSION_base(4,8,0)

395instance ToHttpApiData Void where toUrlPiece = absurd

442instance ToHttpApiData Void where toUrlPiece = absurd

396−instance ToHttpApiData Natural where toUrlPiece = showt

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

397−#endif

444+

398−

399−instance ToHttpApiData Bool where toUrlPiece = showTextData

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

400−instance ToHttpApiData Ordering where toUrlPiece = showTextData

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

401−

447+

402−instance ToHttpApiData Double where toUrlPiece = showt

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

403−instance ToHttpApiData Float where toUrlPiece = showt

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

404−instance ToHttpApiData Int where toUrlPiece = showt

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

405−instance ToHttpApiData Int8 where toUrlPiece = showt

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

406−instance ToHttpApiData Int16 where toUrlPiece = showt

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

407−instance ToHttpApiData Int32 where toUrlPiece = showt

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

408−instance ToHttpApiData Int64 where toUrlPiece = showt

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

409−instance ToHttpApiData Integer where toUrlPiece = showt

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

410−instance ToHttpApiData Word where toUrlPiece = showt

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

411−instance ToHttpApiData Word8 where toUrlPiece = showt

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

412−instance ToHttpApiData Word16 where toUrlPiece = showt

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

413−instance ToHttpApiData Word32 where toUrlPiece = showt

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

414−instance ToHttpApiData Word64 where toUrlPiece = showt

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

461+

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

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

415

464

416-- |

465-- |

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

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

418-- "2015-10-03"

467-- "2015-10-03"

419−instance ToHttpApiData Day where toUrlPiece = T.pack . show

468+instance ToHttpApiData Day where

469+ toUrlPiece = T.pack . show

470+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

420

471

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

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

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

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

423

474

424-- |

475-- |

425−-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)

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

426−-- "2015-10-03T14:55:01"

477+-- "14:55:23.1"

427−instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"

478+instance ToHttpApiData TimeOfDay where

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

480+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

428

481

429-- |

482-- |

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

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

431−-- "2015-10-03T14:55:01+0000"

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

485+instance ToHttpApiData LocalTime where

432−instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"

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

487+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

433

488

434-- |

489-- |

435−-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864

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

436−-- "2015-10-03T00:14:24Z"

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

492+instance ToHttpApiData ZonedTime where

437−instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"

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

494+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

438

495

496+-- |

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

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

499+instance ToHttpApiData UTCTime where

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

501+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

502+

503+-- |

504+-- >>> toUrlPiece Monday

505+-- "monday"

506+instance ToHttpApiData DayOfWeek where

507+ toUrlPiece Monday = "monday"

508+ toUrlPiece Tuesday = "tuesday"

509+ toUrlPiece Wednesday = "wednesday"

510+ toUrlPiece Thursday = "thursday"

511+ toUrlPiece Friday = "friday"

512+ toUrlPiece Saturday = "saturday"

513+ toUrlPiece Sunday = "sunday"

514+

515+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

516+

517+-- |

518+-- >>> toUrlPiece Q4

519+-- "q4"

439−instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)

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

440

557

441instance ToHttpApiData String where toUrlPiece = T.pack

558instance ToHttpApiData String where toUrlPiece = T.pack

442instance ToHttpApiData Text where toUrlPiece = id

559instance ToHttpApiData Text where toUrlPiece = id

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

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

444

561

445−instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll

562+instance ToHttpApiData All where

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

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

565+

446−instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny

566+instance ToHttpApiData Any where

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

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

569+

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

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

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

573+

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

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

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

577+

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

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

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

581+

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

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

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

447

585

448−instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual

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

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

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

589+

449−instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum

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

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

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

593+

450−instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct

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

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

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

597+

451−instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst

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

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

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

601+

452−instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast

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

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

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

453

605

454-- |

606-- |

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

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

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

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

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

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

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

469

621

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+

470-- |

657-- |

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

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

472-- Right ()

659-- Right ()

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

478 parseUrlPiece s =

665 parseUrlPiece s =

479 case T.uncons s of

666 case T.uncons s of

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

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

481− _ -> defaultParseError s

668+ _ -> defaultParseError s

482

669

483-- |

670-- |

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

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

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

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

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

490 _ -> defaultParseError s

677 _ -> defaultParseError s

491

678

492−#if MIN_VERSION_base(4,8,0)

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

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

494instance FromHttpApiData Void where

680instance FromHttpApiData Void where

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

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

@@ -498,9 +684,8 @@ instance FromHttpApiData Natural where

498 parseUrlPiece s = do

684 parseUrlPiece s = do

499 n <- runReader (signed decimal) s

685 n <- runReader (signed decimal) s

500 if n < 0

686 if n < 0

501− then Left ("undeflow: " <> s <> " (should be a non-negative integer)")

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

502 else Right (fromInteger n)

688 else Right (fromInteger n)

503−#endif

504

689

505instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

690instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

506instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

691instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

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

521instance FromHttpApiData Text where parseUrlPiece = Right

706instance FromHttpApiData Text where parseUrlPiece = Right

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

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

523

708

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

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

711+ parseUrlPiece = runReader rational

712+

524-- |

713-- |

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

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

526-- Right (2016,12,1)

715-- Right (2016,12,1)

527−instance FromHttpApiData Day where parseUrlPiece = readTextData

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

528

717

529−timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t

718+-- |

530−timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack)

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

531− where

720+-- Right 14:55:01.333

532− timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt))

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

533

722

534-- |

723-- |

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

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

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

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

537−instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S"

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

538

727

539-- |

728-- |

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

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

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

730-- 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

542−instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z"

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

543

735

544-- |

736-- |

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

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

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

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

547−instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ"

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

740+

741+-- |

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

743+-- Right Monday

744+instance FromHttpApiData DayOfWeek where

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

746+ Just dow -> Right dow

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

748+ where

749+ m :: Map.Map Text DayOfWeek

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

751+

752+

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

548

754

755+-- |

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

757+-- Right 2021-01

549−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece

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

550

759

551−instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece

760+-- |

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

762+-- Right 2021-Q1

552−instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece

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

553

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+

554−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece

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

555−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece

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

556−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece

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

557−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece

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

558−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . 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)

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)

559

792

560-- |

793-- |

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

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

@@ -577,3 +810,58 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)

577 Left _ <!> y = y

810 Left _ <!> y = y

578 x <!> _ = x

811 x <!> _ = x

579

812

813+instance ToHttpApiData UUID.UUID where

814+ toUrlPiece = UUID.toText

815+ toHeader = UUID.toASCIIBytes

816+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

817+

818+instance FromHttpApiData UUID.UUID where

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

820+ 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.yamldeleted−11

@@ -1,11 +0,0 @@

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−extra-package-dbs: []

stack-ghc-7.8.yamldeleted−23

@@ -1,23 +0,0 @@

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−extra-package-dbs: []

stack.yaml+1−6

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

1−resolver: nightly-2016-07-19

1+resolver: lts-12.10

2−

3packages:

2packages:

4- '.'

3- '.'

5−

6flags:

4flags:

7 http-api-data:

5 http-api-data:

8 use-text-show: false

6 use-text-show: false

9−

10−extra-deps: []

11−extra-package-dbs: []

test/DocTest.hsdeleted−31

@@ -1,31 +0,0 @@

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+70−23

@@ -1,34 +1,61 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE ScopedTypeVariables #-}

1{-# LANGUAGE ScopedTypeVariables #-}

3module Web.Internal.HttpApiDataSpec (spec) where

2module Web.Internal.HttpApiDataSpec (spec) where

5−import Data.Int

6−import Data.Word

7−import Data.Time

8−import qualified Data.Text as T

9−import qualified Data.Text.Lazy as L

10−import qualified Data.ByteString as BS

11−import Data.Version

13−import Data.Proxy

5+import Prelude ()

6+import Prelude.Compat

15−#if MIN_VERSION_base(4,8,0)

8+import qualified Data.ByteString as BS

16−import Numeric.Natural

9+import Data.ByteString.Builder (toLazyByteString)

17−#endif

10+import Data.Char

11+import qualified Data.Fixed as F

12+import Data.Int

13+import qualified Data.Text as T

14+import qualified Data.Text.Encoding as TE

15+import qualified Data.Text.Lazy as L

16+import Data.Time.Compat

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

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

19+import qualified Data.UUID.Types as UUID

20+import Data.Version

21+import Data.Word

22+import Web.Cookie (SetCookie, defaultSetCookie,

23+ setCookieName, setCookieValue)

19−import Test.Hspec

25+import Data.Proxy

20−import Test.Hspec.QuickCheck(prop)

21−import Test.QuickCheck

23−import Web.Internal.HttpApiData

27+import Numeric.Natural

25−import Web.Internal.TestInstances

29+import Test.Hspec

30+import Test.Hspec.QuickCheck (prop)

31+import Test.QuickCheck

27−(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool

33+import Web.Internal.HttpApiData

28−(f <=> g) x = g (f x) == Right x

35+import Web.Internal.TestInstances

36+

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

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

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

40+ (lhs == rhs)

41+ where

42+ lhs' = f x

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

44+ rhs = Right x :: Either T.Text a

45+

46+encodedUrlPieceProp :: ToHttpApiData a => a -> Property

47+encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x)

48+

49+-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility

30checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec

50checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec

51+checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a)

52+

53+checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec

54+checkUrlPiece' gen name = describe name $ do

31−checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)

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

33-- | Check case insensitivity for @parseUrlPiece@.

60-- | Check case insensitivity for @parseUrlPiece@.

34checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

61checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

@@ -36,7 +63,7 @@ checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))

37spec :: Spec

64spec :: Spec

38spec = do

65spec = do

39− describe "toUrlPiece <=> parseUrlPiece" $ do

66+ describe "Instances" $ do

40 checkUrlPiece (Proxy :: Proxy ()) "()"

67 checkUrlPiece (Proxy :: Proxy ()) "()"

41 checkUrlPiece (Proxy :: Proxy Char) "Char"

68 checkUrlPiece (Proxy :: Proxy Char) "Char"

42 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"

69 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"

@@ -56,20 +83,34 @@ spec = do

56 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"

83 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"

57 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"

84 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"

58 checkUrlPiece (Proxy :: Proxy Day) "Day"

85 checkUrlPiece (Proxy :: Proxy Day) "Day"

86+ checkUrlPiece (Proxy :: Proxy TimeOfDay) "TimeOfDay"

59 checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"

87 checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"

60 checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"

88 checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"

61 checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"

89 checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"

62 checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"

90 checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"

91+ checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"

92+ checkUrlPiece (Proxy :: Proxy Quarter) "Quarter"

93+ checkUrlPiece (Proxy :: Proxy QuarterOfYear) "QuarterOfYear"

94+ checkUrlPiece (Proxy :: Proxy Month) "Month"

95+ checkUrlPiece (Proxy :: Proxy DayOfWeek) "DayOfWeek"

63 checkUrlPiece (Proxy :: Proxy Version) "Version"

96 checkUrlPiece (Proxy :: Proxy Version) "Version"

97+ checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID"

98+ checkUrlPiece' setCookieGen "Cookie"

99+

100+ checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"

101+ checkUrlPiece (Proxy :: Proxy F.Deci) "Deci"

102+ checkUrlPiece (Proxy :: Proxy F.Centi) "Centi"

103+ checkUrlPiece (Proxy :: Proxy F.Milli) "Milli"

104+ checkUrlPiece (Proxy :: Proxy F.Micro) "Micro"

105+ checkUrlPiece (Proxy :: Proxy F.Nano) "Nano"

106+ checkUrlPiece (Proxy :: Proxy F.Pico) "Pico"

107

65 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

108 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

66 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

109 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

67 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"

110 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"

68 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"

111 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"

112

70−#if MIN_VERSION_base(4,8,0)

71 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

113 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

72−#endif

114

74 it "bad integers are rejected" $ do

115 it "bad integers are rejected" $ do

75 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

116 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

@@ -80,3 +121,9 @@ spec = do

121

81 it "invalid utf8 is handled" $ do

122 it "invalid utf8 is handled" $ do

82 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)

123 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)

124+

125+setCookieGen :: Gen SetCookie

126+setCookieGen = do

127+ n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary

128+ v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary

129+ return $ defaultSetCookie { setCookieName = n, setCookieValue = v }

test/Web/Internal/TestInstances.hs+2−38

@@ -9,58 +9,22 @@ module Web.Internal.TestInstances

9 ) where

11import Control.Applicative

12−import qualified Data.ByteString.Lazy.Char8 as BSL

13import Data.Char

12import Data.Char

14import qualified Data.HashMap.Strict as HashMap

13import qualified Data.HashMap.Strict as HashMap

15import qualified Data.Text as T

14import qualified Data.Text as T

16−import qualified Data.Text.Lazy as L

17−import Data.Time

15+import Data.Time.Compat

18−import Data.Version

19import GHC.Exts (fromList)

16import GHC.Exts (fromList)

20import GHC.Generics

17import GHC.Generics

22import Test.QuickCheck

19import Test.QuickCheck

20+import Test.QuickCheck.Instances ()

24import Web.Internal.FormUrlEncoded

22import Web.Internal.FormUrlEncoded

25import Web.Internal.HttpApiData

23import Web.Internal.HttpApiData

27−instance Arbitrary T.Text where

28− arbitrary = T.pack <$> arbitrary

29−

30−instance Arbitrary L.Text where

31− arbitrary = L.pack <$> arbitrary

32−

33−instance Arbitrary BSL.ByteString where

34− arbitrary = BSL.pack <$> arbitrary

35−

36−instance Arbitrary Day where

37− arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary

38−

39−instance Arbitrary LocalTime where

40− arbitrary = LocalTime

41− <$> arbitrary

42− <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))

43−

44instance Eq ZonedTime where

25instance Eq ZonedTime where

45 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y

26 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y

47−instance Arbitrary ZonedTime where

48− arbitrary = ZonedTime

49− <$> arbitrary

50− <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))

51−

52−instance Arbitrary UTCTime where

53− arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))

54−

55−instance Arbitrary NominalDiffTime where

56− arbitrary = fromInteger <$> arbitrary

57−

58−instance Arbitrary Version where

59− arbitrary = (version . map abs) <$> nonempty

60− where

61− version branch = Version branch []

62− nonempty = liftA2 (:) arbitrary arbitrary

63−

64instance Arbitrary Form where

28instance Arbitrary Form where

65 arbitrary = fromList <$> arbitrary

29 arbitrary = fromList <$> arbitrary