master..57c0a23 · typeable/http-api-data

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

on 57c0a23 help sign in

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

since splitsnapshots

unifiedsplit

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

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

2−#

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

4−#

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

6−#

7−# haskell-ci regenerate

8−#

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

10−#

11−# version: 0.15.20220609

12−#

13−# REGENDATA ("0.15.20220609",["github","cabal.project"])

14−#

15−name: Haskell-CI

16−on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

23−jobs:

24− linux:

25− name: Haskell-CI - Linux - ${{ matrix.compiler }}

26− runs-on: ubuntu-20.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:bionic

31− continue-on-error: ${{ matrix.allow-failure }}

32− strategy:

33− matrix:

34− include:

35− - compiler: ghc-9.4.0.20220523

36− compilerKind: ghc

37− compilerVersion: 9.4.0.20220523

38− setup-method: ghcup

39− allow-failure: true

40− - compiler: ghc-9.2.3

41− compilerKind: ghc

42− compilerVersion: 9.2.3

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-9.0.2

46− compilerKind: ghc

47− compilerVersion: 9.0.2

48− setup-method: ghcup

49− allow-failure: false

50− - compiler: ghc-8.10.7

51− compilerKind: ghc

52− compilerVersion: 8.10.7

53− setup-method: ghcup

54− allow-failure: false

55− - compiler: ghc-8.8.4

56− compilerKind: ghc

57− compilerVersion: 8.8.4

58− setup-method: hvr-ppa

59− allow-failure: false

60− - compiler: ghc-8.6.5

61− compilerKind: ghc

62− compilerVersion: 8.6.5

63− setup-method: hvr-ppa

64− allow-failure: false

65− - compiler: ghc-8.4.4

66− compilerKind: ghc

67− compilerVersion: 8.4.4

68− setup-method: hvr-ppa

69− allow-failure: false

70− - compiler: ghc-8.2.2

71− compilerKind: ghc

72− compilerVersion: 8.2.2

73− setup-method: hvr-ppa

74− allow-failure: false

75− - compiler: ghc-8.0.2

76− compilerKind: ghc

77− compilerVersion: 8.0.2

78− setup-method: hvr-ppa

79− allow-failure: false

80− fail-fast: false

81− steps:

82− - name: apt

83− run: |

84− apt-get update

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

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

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

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

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

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

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

92− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

93− else

94− apt-add-repository -y 'ppa:hvr/ghc'

95− apt-get update

96− apt-get install -y "$HCNAME"

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

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

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

100− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

101− fi

102− env:

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

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

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

106− - name: Set PATH and environment variables

107− run: |

108− echo "$HOME/.cabal/bin" >> $GITHUB_PATH

109− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"

110− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

111− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

112− HCDIR=/opt/$HCKIND/$HCVER

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

114− HC=$HOME/.ghcup/bin/$HCKIND-$HCVER

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

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

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

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

119− else

120− HC=$HCDIR/bin/$HCKIND

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

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

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

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

125− fi

126−

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

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

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

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

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

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

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

134− env:

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

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

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

138− - name: env

139− run: |

140− env

141− - name: write cabal config

142− run: |

143− mkdir -p $CABAL_DIR

144− cat >> $CABAL_CONFIG <<EOF

145− remote-build-reporting: anonymous

146− write-ghc-environment-files: never

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

148− logs-dir: $CABAL_DIR/logs

149− world-file: $CABAL_DIR/world

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

151− symlink-bindir: $CABAL_DIR/bin

152− installdir: $CABAL_DIR/bin

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

154− store-dir: $CABAL_DIR/store

155− install-dirs user

156− prefix: $CABAL_DIR

157− repository hackage.haskell.org

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

159− EOF

160− if $HEADHACKAGE; then

161− cat >> $CABAL_CONFIG <<EOF

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

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

164− secure: True

165− root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d

166− 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329

167− f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89

168− key-threshold: 3

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

170− EOF

171− fi

172− cat >> $CABAL_CONFIG <<EOF

173− program-default-options

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

175− EOF

176− cat $CABAL_CONFIG

177− - name: versions

178− run: |

179− $HC --version || true

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

181− $CABAL --version || true

182− - name: update cabal index

183− run: |

184− $CABAL v2-update -v

185− - name: cache (tools)

186− uses: actions/cache@v2

187− with:

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

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

190− - name: install cabal-plan

191− run: |

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

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

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

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

196− rm -f cabal-plan.xz

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

198− cabal-plan --version

199− - name: install doctest

200− run: |

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

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

203− - name: checkout

204− uses: actions/checkout@v2

205− with:

206− path: source

207− - name: initial cabal.project for sdist

208− run: |

209− touch cabal.project

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

211− cat cabal.project

212− - name: sdist

213− run: |

214− mkdir -p sdist

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

216− - name: unpack

217− run: |

218− mkdir -p unpacked

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

220− - name: generate cabal.project

221− run: |

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

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

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

225− touch cabal.project

226− touch cabal.project.local

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

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

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

230− cat >> cabal.project <<EOF

231− EOF

232− if $HEADHACKAGE; then

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

234− fi

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

236− cat cabal.project

237− cat cabal.project.local

238− - name: dump install plan

239− run: |

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

241− cabal-plan

242− - name: cache

243− uses: actions/cache@v2

244− with:

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

246− path: ~/.cabal/store

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

248− - name: install dependencies

249− run: |

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

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

252− - name: build w/o tests

253− run: |

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

255− - name: build

256− run: |

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

258− - name: tests

259− run: |

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

261− - name: doctest

262− run: |

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

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

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

266− - name: cabal check

267− run: |

268− cd ${PKGDIR_http_api_data} || false

269− ${CABAL} -vnormal check

270− - name: haddock

271− run: |

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

273− - name: unconstrained build

274− run: |

275− rm -f cabal.project.local

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

277− - name: prepare for constraint sets

278− run: |

279− rm -f cabal.project.local

280− - name: constraint set text-show

281− run: |

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

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

.gitignore−2

@@ -1,6 +1,4 @@

1/dist/

2−/dist-newstyle/

3−/.ghc.environment.*

4/.shelly/

2/.shelly/

5/tarballs/

3/tarballs/

6*.swp

4*.swp

.travis.ymlnew file+35

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

1+sudo: false

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−136

@@ -1,139 +1,3 @@

1−0.5

2−---

3−

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

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

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

7−

8−0.4.3

9−-----

10−

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

12−* Support `bytestring-0.11`

13−

14−0.4.2

15−-----

16−

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

18−

19−0.4.1.1

20−-------

21−

22−* Allow cookie <0.5

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

24−

25−0.4.1

26−-----

27−

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

29−

30−0.4

31−---

32−

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

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

35−* Add `Tagged b a` instances

36−

37−0.3.10

38−---

39−

40−* Fix 'SetCookie' instances

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

42−* Add support for `Fixed`

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

44−

45−0.3.9

46−---

47−

48−* GHC-8.6 support

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

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

51−* Add support for `SetCookie`

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

53−

54−0.3.8.1

55−---

56−

57−* GHC-8.4.1 support

58−

59−0.3.8

60−---

61−

62−* Minor changes:

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

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

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

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

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

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

69−

70−0.3.7.2

71−---

72−

73−* Allow http-types-0.12

74−* .cabal file adjustments

75−

76−0.3.7.1

77−---

78−

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

80−

81−0.3.7

82−---

83−

84−* Minor changes:

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

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

87− i.e. parsers are more lenient

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

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

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

91−

92−0.3.6

93−---

94−

95−* Minor change:

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

97−

98−0.3.5

99−---

100−

101−* Minor changes:

102− * Add `LenientData` which always succeeds to parse (see [#45](https://github.com/fizruk/http-api-data/pull/45)).

103−

104−0.3.4

105−---

106−

107−* Minor changes:

108− * Add support for GHC 8.2, drop support for GHC 7.6 (see [#44](https://github.com/fizruk/http-api-data/pull/44)).

109−

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−

129−0.3

130−---

131−* Major changes:

132− * Add `Web.FormUrlEncoded` to work with form data (see [#32](https://github.com/fizruk/http-api-data/pull/32)).

133−

134−* Minor changes:

135− * Add instances for `Numeric.Natural` (see [`d944721`](https://github.com/fizruk/http-api-data/commit/d944721ac94929a7ed9e66f25e23221799c08d83)).

136−

1370.2.4

10.2.4

138---

2---

139* Make `parseHeader` total (instead of throwing exceptions on invalid Unicode, see [#30](https://github.com/fizruk/http-api-data/pull/30)).

3* Make `parseHeader` total (instead of throwing exceptions on invalid Unicode, see [#30](https://github.com/fizruk/http-api-data/pull/30)).

Setup.hsdeleted−2

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

1−import Distribution.Simple

2−main = defaultMain

Setup.lhsnew file+48

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

1+#!/usr/bin/runhaskell

2+\begin{code}

3+{-# OPTIONS_GHC -Wall #-}

4+module Main (main) where

6+import Data.List ( nub )

7+import Data.Version ( showVersion )

8+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )

9+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )

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

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

12+import Distribution.Simple.BuildPaths ( autogenModulesDir )

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

14+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )

15+import Distribution.Verbosity ( Verbosity )

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

17+

18+main :: IO ()

19+main = defaultMainWithHooks simpleUserHooks

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

21+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi

22+ buildHook simpleUserHooks pkg lbi hooks flags

23+ }

24+

25+generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()

26+generateBuildModule verbosity pkg lbi = do

27+ let dir = autogenModulesDir lbi

28+ createDirectoryIfMissingVerbose verbosity True dir

29+ withLibLBI pkg lbi $ \_ libcfg -> do

30+ withTestLBI pkg lbi $ \suite suitecfg -> do

31+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines

32+ [ "module Build_" ++ testName suite ++ " where"

33+ , ""

34+ , "autogen_dir :: String"

35+ , "autogen_dir = " ++ show dir

36+ , ""

37+ , "deps :: [String]"

38+ , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))

39+ ]

40+ where

41+ formatdeps = map (formatone . snd)

42+ formatone p = case packageName p of

43+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)

44+

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

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

47+

48+\end{code}

cabal.haskell-cideleted−6

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

1−branches: master

2−doctest: <9

3−doctest-filter-packages: base-compat

4−

5−constraint-set text-show

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

cabal.projectdeleted−2

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

1−packages: .

2−tests: True

http-api-data.cabal+34−65

@@ -1,72 +1,39 @@

1−cabal-version: >= 1.10

2name: http-api-data

1name: http-api-data

3−version: 0.5

2+version: 0.2.4

4−

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

6−category: Web

7−description:

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

9− .

10− Please see README.md

11−

12license: BSD3

3license: BSD3

13license-file: LICENSE

4license-file: LICENSE

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

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

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

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

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

8+description: Please see README.md

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

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

10+category: Web

17stability: unstable

11stability: unstable

12+cabal-version: >= 1.10

18−build-type: Simple

13+build-type: Custom

19−

20extra-source-files:

14extra-source-files:

21− include/overlapping-compat.h

22 test/*.hs

15 test/*.hs

23 CHANGELOG.md

16 CHANGELOG.md

24 README.md

17 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−

37flag use-text-show

19flag use-text-show

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

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

39 default: False

21 default: False

40− manual: True

42library

23library

43 hs-source-dirs: src/

24 hs-source-dirs: src/

44− include-dirs: include/

45−

46− -- GHC bundled

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

25+ build-depends: base >= 4.6 && < 4.10

48− , bytestring >= 0.10.8.1 && < 0.12

26+ , bytestring

49− , containers >= 0.5.7.1 && < 0.7

27+ , containers

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

51− , transformers >= 0.5.2.0 && < 0.7

52−

53− -- other-dependencies

54− build-depends:

55− attoparsec >= 0.13.2.2 && < 0.15

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

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

58− , cookie >= 0.4.3 && < 0.5

59− , hashable >= 1.2.7.0 && < 1.5

28+ , hashable

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

29+ , text >= 0.5

61− , tagged >= 0.8.5 && < 0.9

30+ , time

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

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

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

32+ , unordered-containers

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

33+ , uri-bytestring

65−

66 if flag(use-text-show)

34 if flag(use-text-show)

67 cpp-options: -DUSE_TEXT_SHOW

35 cpp-options: -DUSE_TEXT_SHOW

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

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

69−

70 exposed-modules:

37 exposed-modules:

71 Web.HttpApiData

38 Web.HttpApiData

72 Web.FormUrlEncoded

39 Web.FormUrlEncoded

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

85 hs-source-dirs: test

52 hs-source-dirs: test

86 ghc-options: -Wall

53 ghc-options: -Wall

87 default-language: Haskell2010

54 default-language: Haskell2010

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

55+ build-depends: HUnit

89− -- inherited depndencies

56+ , hspec >= 1.3

90− build-depends:

57+ , base >= 4 && < 5

91− base

92− , base-compat

93 , bytestring

58 , bytestring

94− , cookie

59+ , QuickCheck

60+ , unordered-containers

95 , http-api-data

61 , http-api-data

96 , text

62 , text

97− , time-compat

63+ , time

98− , unordered-containers

64+ , bytestring

99− , uuid-types

100−

101− if !impl(ghc >= 7.10)

102− build-depends: nats

103

66+test-suite doctest

67+ ghc-options: -Wall

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

68+ build-depends:

105− , hspec >= 2.7.1 && <2.11

69+ base,

106− , QuickCheck >= 2.13.1 && <2.15

70+ directory >= 1.0,

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

71+ doctest >= 0.11 && <0.12,

72+ filepath

73+ default-language: Haskell2010

74+ hs-source-dirs: test

75+ main-is: DocTest.hs

76+ type: exitcode-stdio-1.0

108

109source-repository head

78source-repository head

110 type: git

79 type: git

include/overlapping-compat.hdeleted−8

@@ -1,8 +0,0 @@

1−#if __GLASGOW_HASKELL__ >= 710

2−#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}

3−#define OVERLAPPING_ {-# OVERLAPPING #-}

4−#else

5−{-# LANGUAGE OverlappingInstances #-}

6−#define OVERLAPPABLE_

7−#define OVERLAPPING_

8−#endif

src/Web/FormUrlEncoded.hs+1−17

@@ -9,43 +9,27 @@ module Web.FormUrlEncoded (

9 ToFormKey(..),

10 FromFormKey(..),

12− -- * 'Form' type

13− Form(..),

14−

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

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

16 urlEncodeAsForm,

13 urlEncodeAsForm,

17− urlEncodeAsFormStable,

18 urlDecodeAsForm,

14 urlDecodeAsForm,

20 urlEncodeForm,

16 urlEncodeForm,

21− urlEncodeFormStable,

22 urlDecodeForm,

17 urlDecodeForm,

24 -- * 'Generic's

19 -- * 'Generic's

25 genericToForm,

20 genericToForm,

26 genericFromForm,

21 genericFromForm,

28− -- ** Encoding options

29− FormOptions(..),

30− defaultFormOptions,

31−

32 -- * Helpers

23 -- * Helpers

33− toListStable,

34 toEntriesByKey,

24 toEntriesByKey,

35− toEntriesByKeyStable,

36 fromEntriesByKey,

25 fromEntriesByKey,

38 lookupAll,

27 lookupAll,

39− lookupMaybe,

40 lookupUnique,

28 lookupUnique,

42 parseAll,

30 parseAll,

43− parseMaybe,

44 parseUnique,

31 parseUnique,

45−

46− urlEncodeParams,

47− urlDecodeParams,

48) where

32) where

50−import Web.Internal.FormUrlEncoded

34+import Web.Internal.FormUrlEncoded

src/Web/HttpApiData.hs+3−5

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

35 parseBoundedEnumOfI,

36 parseBoundedTextData,

38− -- * Lenient data

39− LenientData (..),

40−

41 -- * Other helpers

38 -- * Other helpers

42 showTextData,

39 showTextData,

43 readTextData,

40 readTextData,

44) where

41) where

46−import Web.Internal.HttpApiData

43+import Web.Internal.HttpApiData

48-- $setup

45-- $setup

49--

46--

50-- >>> :set -XOverloadedStrings

47-- >>> :set -XOverloadedStrings

51-- >>> import Control.Applicative

48-- >>> import Control.Applicative

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

49+-- >>> import Data.Time

53-- >>> import Data.Int

50-- >>> import Data.Int

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

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

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

55-- >>> import Data.Version

53-- >>> import Data.Version

57-- $examples

55-- $examples

src/Web/Internal/FormUrlEncoded.hs+78−305

@@ -1,4 +1,3 @@

1−{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE CPP #-}

1{-# LANGUAGE CPP #-}

3{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE DefaultSignatures #-}

3{-# LANGUAGE DefaultSignatures #-}

@@ -14,54 +13,56 @@

14{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE TypeFamilies #-}

15{-# LANGUAGE TypeOperators #-}

14{-# LANGUAGE TypeOperators #-}

16{-# LANGUAGE UndecidableInstances #-}

15{-# LANGUAGE UndecidableInstances #-}

17−#include "overlapping-compat.h"

18module Web.Internal.FormUrlEncoded where

16module Web.Internal.FormUrlEncoded where

20−import Prelude ()

18+#if __GLASGOW_HASKELL__ < 710

21−import Prelude.Compat

19+import Control.Applicative

20+import Data.Traversable

21+#endif

22+

23+#if __GLASGOW_HASKELL__ < 800

24+import GHC.Exts (IsList (..))

25+#else

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

27+import GHC.TypeLits

28+#endif

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

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

30import Control.Arrow ((***))

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

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

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

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

27import qualified Data.ByteString.Lazy as BSL

33import qualified Data.ByteString.Lazy as BSL

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

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

29−import Data.Coerce (coerce)

30import qualified Data.Foldable as F

35import qualified Data.Foldable as F

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

32import Data.Hashable (Hashable)

36import Data.Hashable (Hashable)

33import Data.HashMap.Strict (HashMap)

37import Data.HashMap.Strict (HashMap)

34import qualified Data.HashMap.Strict as HashMap

38import qualified Data.HashMap.Strict as HashMap

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

39+import Data.Int

36import Data.IntMap (IntMap)

40import Data.IntMap (IntMap)

37import qualified Data.IntMap as IntMap

41import qualified Data.IntMap as IntMap

38−import Data.List (intersperse, sortBy)

42+import Data.List (intersperse)

39import Data.Map (Map)

43import Data.Map (Map)

40import qualified Data.Map as Map

44import qualified Data.Map as Map

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

45+import Data.Monoid

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

46+

43−import Data.Ord (comparing)

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

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

46−import qualified Data.Semigroup as Semi

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

48import Data.Text (Text)

47import Data.Text (Text)

49import qualified Data.Text as Text

48import qualified Data.Text as Text

50−import qualified Data.Text.Encoding as Text

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

52import qualified Data.Text.Lazy as Lazy

49import qualified Data.Text.Lazy as Lazy

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

50+import Data.Text.Encoding as Text

54− UTCTime, ZonedTime)

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

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

52+

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

53+import Data.Time

57−import Data.Void (Void)

54+import Data.Proxy

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

55+import Data.Word

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

56+

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

58+import Data.Void

59+import Numeric.Natural

60+#endif

61+

60import GHC.Generics

62import GHC.Generics

61−import GHC.TypeLits

63+import URI.ByteString (urlEncodeQuery, urlDecodeQuery)

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

64+

63−import Numeric.Natural (Natural)

64−import Web.Internal.HttpApiData

65+import Web.Internal.HttpApiData

66-- $setup

67-- $setup

67-- >>> :set -XDeriveGeneric

68-- >>> :set -XDeriveGeneric

@@ -70,20 +71,11 @@ import Web.Internal.HttpApiData

70-- >>> :set -XFlexibleContexts

71-- >>> :set -XFlexibleContexts

71-- >>> :set -XScopedTypeVariables

72-- >>> :set -XScopedTypeVariables

72-- >>> :set -XTypeFamilies

73-- >>> :set -XTypeFamilies

73−-- >>> import Data.Char (toLower)

74+-- >>> import Data.Either (isLeft)

74−--

75+-- >>> import Data.List (sort)

75-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)

76-- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic)

76-- >>> instance ToForm Person

77-- >>> instance ToForm Person

77-- >>> instance FromForm Person

78-- >>> instance FromForm Person

78−--

79−-- >>> data Post = Post { title :: String, subtitle :: Maybe String, comments :: [String]} deriving (Generic, Show)

80−-- >>> instance ToForm Post

81−-- >>> instance FromForm Post

82−--

83−-- >>> data Project = Project { projectName :: String, projectSize :: Int } deriving (Generic, Show)

84−-- >>> let myOptions = FormOptions { fieldLabelModifier = map toLower . drop (length ("project" :: String)) }

85−-- >>> instance ToForm Project where toForm = genericToForm myOptions

86−-- >>> instance FromForm Project where fromForm = genericFromForm myOptions

88-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').

80-- | Typeclass for types that can be used as keys in a 'Form'-like container (like 'Map').

89class ToFormKey k where

81class ToFormKey k where

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

115instance ToFormKey ZonedTime where toFormKey = toQueryParam

107instance ToFormKey ZonedTime where toFormKey = toQueryParam

116instance ToFormKey UTCTime where toFormKey = toQueryParam

108instance ToFormKey UTCTime where toFormKey = toQueryParam

117instance ToFormKey NominalDiffTime where toFormKey = toQueryParam

109instance ToFormKey NominalDiffTime where toFormKey = toQueryParam

118−instance ToFormKey Quarter where toFormKey = toQueryParam

119−instance ToFormKey QuarterOfYear where toFormKey = toQueryParam

120−instance ToFormKey Month where toFormKey = toQueryParam

121

110

122instance ToFormKey String where toFormKey = toQueryParam

111instance ToFormKey String where toFormKey = toQueryParam

123instance ToFormKey Text where toFormKey = toQueryParam

112instance ToFormKey Text where toFormKey = toQueryParam

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

126instance ToFormKey All where toFormKey = toQueryParam

115instance ToFormKey All where toFormKey = toQueryParam

127instance ToFormKey Any where toFormKey = toQueryParam

116instance ToFormKey Any where toFormKey = toQueryParam

128

117

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

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

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

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

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

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

132−

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

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

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

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

137−

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

139−

140−-- | @since 0.4.2

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

142−

143−-- | @since 0.4.2

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

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

146

121

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

147instance ToFormKey Void where toFormKey = toQueryParam

123instance ToFormKey Void where toFormKey = toQueryParam

148instance ToFormKey Natural where toFormKey = toQueryParam

124instance ToFormKey Natural where toFormKey = toQueryParam

125+#endif

149

126

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

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

151class FromFormKey k where

128class FromFormKey k where

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

177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam

154instance FromFormKey ZonedTime where parseFormKey = parseQueryParam

178instance FromFormKey UTCTime where parseFormKey = parseQueryParam

155instance FromFormKey UTCTime where parseFormKey = parseQueryParam

179instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam

156instance FromFormKey NominalDiffTime where parseFormKey = parseQueryParam

180−instance FromFormKey Quarter where parseFormKey = parseQueryParam

181−instance FromFormKey QuarterOfYear where parseFormKey = parseQueryParam

182−instance FromFormKey Month where parseFormKey = parseQueryParam

183

157

184instance FromFormKey String where parseFormKey = parseQueryParam

158instance FromFormKey String where parseFormKey = parseQueryParam

185instance FromFormKey Text where parseFormKey = parseQueryParam

159instance FromFormKey Text where parseFormKey = parseQueryParam

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

188instance FromFormKey All where parseFormKey = parseQueryParam

162instance FromFormKey All where parseFormKey = parseQueryParam

189instance FromFormKey Any where parseFormKey = parseQueryParam

163instance FromFormKey Any where parseFormKey = parseQueryParam

190

164

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

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

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

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

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

194−

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

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

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

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

199−

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

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

201−

202−-- | @since 0.4.2

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

204−

205−-- | @since 0.4.2

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

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

208

168

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

209instance FromFormKey Void where parseFormKey = parseQueryParam

170instance FromFormKey Void where parseFormKey = parseQueryParam

210instance FromFormKey Natural where parseFormKey = parseQueryParam

171instance FromFormKey Natural where parseFormKey = parseQueryParam

172+#endif

211

173

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

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

213--

175--

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

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

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

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

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

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

217

179

218instance Show Form where

180instance Show Form where

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

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

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

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

221

183

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

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

224instance IsList Form where

184instance IsList Form where

225 type Item Form = (Text, Text)

185 type Item Form = (Text, Text)

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

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

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

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

228

188

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

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

231−toListStable = sortOn fst . toList

232−

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

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

234--

190--

235-- An example type and instance:

191-- An example type and instance:

@@ -266,6 +222,7 @@ toListStable = sortOn fst . toList

266-- @

222-- @

267--

223--

268-- The default implementation of 'toForm' is 'genericToForm'.

224-- The default implementation of 'toForm' is 'genericToForm'.

225+-- It only works for records and it will use 'toQueryParam' for each field's value.

269class ToForm a where

226class ToForm a where

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

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

271 toForm :: a -> Form

228 toForm :: a -> Form

@@ -297,8 +254,6 @@ data Proxy3 a b c = Proxy3

297

254

298type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where

255type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where

299#if __GLASGOW_HASKELL__ < 800

256#if __GLASGOW_HASKELL__ < 800

300− -- this is just a placeholder case for older GHCs to not freak out on an empty closed type family

301− NotSupported cls a "this type family is actually empty" = ()

302#else

257#else

303 NotSupported cls a reason = TypeError

258 NotSupported cls a reason = TypeError

304 ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:

259 ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$:

@@ -318,30 +273,6 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint

318-- , age :: Int

273-- , age :: Int

319-- } deriving ('Generic')

274-- } deriving ('Generic')

320-- @

275-- @

321−--

322−-- In this implementation each field's value gets encoded using `toQueryParam`.

323−-- Two field types are exceptions:

324−--

325−-- - for values of type @'Maybe' a@ an entry is added to the 'Form' only when it is @'Just' x@

326−-- and the encoded value is @'toQueryParam' x@; 'Nothing' values are omitted from the 'Form';

327−--

328−-- - for values of type @[a]@ (except @['Char']@) an entry is added for every item in the list;

329−-- if the list is empty no entries are added to the 'Form';

330−--

331−-- Here's an example:

332−--

333−-- @

334−-- data Post = Post

335−-- { title :: String

336−-- , subtitle :: Maybe String

337−-- , comments :: [String]

338−-- } deriving ('Generic', 'Show')

339−--

340−-- instance 'ToForm' Post

341−-- @

342−--

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

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

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

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

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

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

347

278

@@ -357,25 +288,7 @@ instance (GToForm t f) => GToForm t (M1 D x f) where

357instance (GToForm t f) => GToForm t (M1 C x f) where

288instance (GToForm t f) => GToForm t (M1 C x f) where

358 gToForm p opts (M1 a) = gToForm p opts a

289 gToForm p opts (M1 a) = gToForm p opts a

359

290

360−instance OVERLAPPABLE_ (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where

361− gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]

362− where

363− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

364−

365−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i (Maybe c))) where

291+instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where

366− gToForm _ opts (M1 (K1 c)) =

367− case c of

368− Nothing -> mempty

369− Just x -> fromList [(key, toQueryParam x)]

370− where

371− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

372−

373−instance (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i [c])) where

374− gToForm _ opts (M1 (K1 cs)) = fromList (map (\c -> (key, toQueryParam c)) cs)

375− where

376− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

377−

378−instance OVERLAPPING_ (Selector s) => GToForm t (M1 S s (K1 i String)) where

379 gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]

292 gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)]

380 where

293 where

381 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

294 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

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

392-- , age :: Int }

305-- , age :: Int }

393--

306--

394-- instance 'FromForm' Person where

307-- instance 'FromForm' Person where

395−-- 'fromForm' f = Person

308+-- 'fromForm' (Form m) = Person

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

309+-- '<$>' 'parseUnique' "name" m

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

310+-- '<*>' 'parseUnique' "age" m

398-- @

311-- @

399--

312--

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

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

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

425

338

426instance FromForm Form where fromForm = pure

339instance FromForm Form where fromForm = pure

427

340

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

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

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

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

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

431

343

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

440

352

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

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

442--

354--

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

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

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

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

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

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

446toEntriesByKey = traverse parseGroup . HashMap.toList . unForm

358toEntriesByKey = traverse parseGroup . HashMap.toList . unForm

447 where

359 where

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

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

449

361

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

451−--

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

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

454−--

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

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

457−toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey

458−

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

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

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

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

461--

364--

@@ -467,29 +370,6 @@ toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey

467-- , age :: Int

370-- , age :: Int

468-- } deriving ('Generic')

371-- } deriving ('Generic')

469-- @

372-- @

470−--

471−-- In this implementation each field's value gets decoded using `parseQueryParam`.

472−-- Two field types are exceptions:

473−--

474−-- - for values of type @'Maybe' a@ an entry is parsed if present in the 'Form'

475−-- and the is decoded with 'parseQueryParam'; if no entry is present result is 'Nothing';

476−--

477−-- - for values of type @[a]@ (except @['Char']@) all entries are parsed to produce a list of parsed values;

478−--

479−-- Here's an example:

480−--

481−-- @

482−-- data Post = Post

483−-- { title :: String

484−-- , subtitle :: Maybe String

485−-- , comments :: [String]

486−-- } deriving ('Generic', 'Show')

487−--

488−-- instance 'FromForm' Post

489−-- @

490−--

491−-- >>> urlDecodeAsForm "comments=Nice%20post%21&comments=%2B1&title=Test" :: Either Text Post

492−-- Right (Post {title = "Test", subtitle = Nothing, comments = ["Nice post!","+1"]})

493genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a

373genericFromForm :: forall a. (Generic a, GFromForm a (Rep a)) => FormOptions -> Form -> Either Text a

494genericFromForm opts f = to <$> gFromForm (Proxy :: Proxy a) opts f

374genericFromForm opts f = to <$> gFromForm (Proxy :: Proxy a) opts f

495

375

@@ -499,83 +379,54 @@ class GFromForm t (f :: * -> *) where

499instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where

379instance (GFromForm t f, GFromForm t g) => GFromForm t (f :*: g) where

500 gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f

380 gFromForm p opts f = (:*:) <$> gFromForm p opts f <*> gFromForm p opts f

501

381

502−instance GFromForm t f => GFromForm t (M1 D x f) where

503− gFromForm p opts f = M1 <$> gFromForm p opts f

504−

505−instance GFromForm t f => GFromForm t (M1 C x f) where

506− gFromForm p opts f = M1 <$> gFromForm p opts f

507−

508−instance OVERLAPPABLE_ (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where

382+instance (Selector s, FromHttpApiData f) => GFromForm t (M1 S s (K1 i f)) where

509 gFromForm _ opts form = M1 . K1 <$> parseUnique key form

383 gFromForm _ opts form = M1 . K1 <$> parseUnique key form

510 where

384 where

511 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

385 key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

512

386

513−instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i (Maybe c))) where

387+instance GFromForm t f => GFromForm t (M1 D x f) where

514− gFromForm _ opts form = M1 . K1 <$> parseMaybe key form

515− where

516− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

517−

518−instance (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i [c])) where

519− gFromForm _ opts form = M1 . K1 <$> parseAll key form

388+ gFromForm p opts f = M1 <$> gFromForm p opts f

520− where

521− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

522

389

523−instance OVERLAPPING_ (Selector s) => GFromForm t (M1 S s (K1 i String)) where

390+instance GFromForm t f => GFromForm t (M1 C x f) where

524− gFromForm _ opts form = M1 . K1 <$> parseUnique key form

391+ gFromForm p opts f = M1 <$> gFromForm p opts f

525− where

526− key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)

527

392

528instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"

393instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where gFromForm = error "impossible"

529

394

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

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

531--

396--

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

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

534−urlEncodeForm :: Form -> BSL.ByteString

535−urlEncodeForm = urlEncodeParams . toList

536−

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

538−--

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

540−--

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

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

542--

398--

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

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

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

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

545--

401--

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

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

547--

403--

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

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

549-- "is_test"

405-- "is_test"

550--

406--

551-- Empty keys are allowed too:

407-- Empty keys are allowed too:

552--

408--

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

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

554-- "=foobar"

410-- "=foobar"

555--

411--

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

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

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

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

558--

414--

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

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

560-- ""

416-- ""

561--

417--

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

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

563--

419--

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

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

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

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

566−urlEncodeFormStable :: Form -> BSL.ByteString

422+urlEncodeForm :: Form -> BSL.ByteString

567−urlEncodeFormStable = urlEncodeParams . sortOn fst . toList

568−

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

570−--

571−-- See also 'urlEncodeFormStable'.

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

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

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

574 where

424 where

575− escape = urlEncodeBuilder True . Text.encodeUtf8

425+ escape = urlEncodeQuery . Text.encodeUtf8

576

426

577 encodePair (k, "") = escape k

427 encodePair (k, "") = escape k

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

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

429+

579

430

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

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

581--

432--

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

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

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

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

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

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

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

612−urlDecodeForm = fmap toForm . urlDecodeParams

613−

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

615−--

616−-- See also 'urlDecodeForm'.

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

618−urlDecodeParams bs = traverse parsePair pairs

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

619 where

464 where

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

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

621

466

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

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

623

468

624 parsePair p =

469 parsePair p =

625 case map unescape p of

470 case map unescape p of

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

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

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

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

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

629

474

630−

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

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

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

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

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

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

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

645--

489--

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

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

647--

491--

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

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

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

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

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

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

651urlEncodeAsForm = urlEncodeForm . toForm

495urlEncodeAsForm = urlEncodeForm . toForm

652

496

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

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

655−-- 'BSL.ByteString'.

656−--

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

658−--

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

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

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

662−urlEncodeAsFormStable = urlEncodeFormStable . toForm

663−

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

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

665--

498--

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

499-- >>> lookupAll "name" []

@@ -672,22 +505,6 @@ urlEncodeAsFormStable = urlEncodeFormStable . toForm

672lookupAll :: Text -> Form -> [Text]

505lookupAll :: Text -> Form -> [Text]

673lookupAll key = F.concat . HashMap.lookup key . unForm

506lookupAll key = F.concat . HashMap.lookup key . unForm

674

507

675−-- | Lookup an optional value for a key.

676−-- Fail if there is more than one value.

677−--

678−-- >>> lookupMaybe "name" []

679−-- Right Nothing

680−-- >>> lookupMaybe "name" [("name", "Oleg")]

681−-- Right (Just "Oleg")

682−-- >>> lookupMaybe "name" [("name", "Oleg"), ("name", "David")]

683−-- Left "Duplicate key \"name\""

684−lookupMaybe :: Text -> Form -> Either Text (Maybe Text)

685−lookupMaybe key form =

686− case lookupAll key form of

687− [] -> pure Nothing

688− [v] -> pure (Just v)

689− _ -> Left $ "Duplicate key " <> Text.pack (show key)

690−

691-- | Lookup a unique value for a key.

508-- | Lookup a unique value for a key.

692-- Fail if there is zero or more than one value.

509-- Fail if there is zero or more than one value.

693--

510--

@@ -698,11 +515,11 @@ lookupMaybe key form =

698-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]

515-- >>> lookupUnique "name" [("name", "Oleg"), ("name", "David")]

699-- Left "Duplicate key \"name\""

516-- Left "Duplicate key \"name\""

700lookupUnique :: Text -> Form -> Either Text Text

517lookupUnique :: Text -> Form -> Either Text Text

701−lookupUnique key form = do

518+lookupUnique key form =

702− mv <- lookupMaybe key form

703− case mv of

519+ case lookupAll key form of

704− Just v -> pure v

520+ [v] -> pure v

705− Nothing -> Left $ "Could not find key " <> Text.pack (show key)

521+ [] -> Left $ "Could not find key " <> Text.pack (show key)

522+ _ -> Left $ "Duplicate key " <> Text.pack (show key)

706

523

707-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.

524-- | Lookup all values for a given key in a 'Form' and parse them with 'parseQueryParams'.

708--

525--

@@ -717,22 +534,6 @@ lookupUnique key form = do

717parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]

534parseAll :: FromHttpApiData v => Text -> Form -> Either Text [v]

718parseAll key = parseQueryParams . lookupAll key

535parseAll key = parseQueryParams . lookupAll key

719

536

720−-- | Lookup an optional value for a given key and parse it with 'parseQueryParam'.

721−-- Fail if there is more than one value for the key.

722−--

723−-- >>> parseMaybe "age" [] :: Either Text (Maybe Word8)

724−-- Right Nothing

725−-- >>> parseMaybe "age" [("age", "12"), ("age", "25")] :: Either Text (Maybe Word8)

726−-- Left "Duplicate key \"age\""

727−-- >>> parseMaybe "age" [("age", "seven")] :: Either Text (Maybe Word8)

728−-- Left "could not parse: `seven' (input does not start with a digit)"

729−-- >>> parseMaybe "age" [("age", "777")] :: Either Text (Maybe Word8)

730−-- Left "out of bounds: `777' (should be between 0 and 255)"

731−-- >>> parseMaybe "age" [("age", "7")] :: Either Text (Maybe Word8)

732−-- Right (Just 7)

733−parseMaybe :: FromHttpApiData v => Text -> Form -> Either Text (Maybe v)

734−parseMaybe key = parseQueryParams <=< lookupMaybe key

735−

736-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.

537-- | Lookup a unique value for a given key and parse it with 'parseQueryParam'.

737-- Fail if there is zero or more than one value for the key.

538-- Fail if there is zero or more than one value for the key.

738--

539--

@@ -750,31 +551,6 @@ parseUnique :: FromHttpApiData v => Text -> Form -> Either Text v

750parseUnique key form = lookupUnique key form >>= parseQueryParam

551parseUnique key form = lookupUnique key form >>= parseQueryParam

751

552

752-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.

553-- | 'Generic'-based deriving options for 'ToForm' and 'FromForm'.

753−--

754−-- A common use case for non-default 'FormOptions'

755−-- is to strip a prefix off of field labels:

756−--

757−-- @

758−-- data Project = Project

759−-- { projectName :: String

760−-- , projectSize :: Int

761−-- } deriving ('Generic', 'Show')

762−--

763−-- myOptions :: 'FormOptions'

764−-- myOptions = 'FormOptions'

765−-- { 'fieldLabelModifier' = 'map' 'toLower' . 'drop' ('length' \"project\") }

766−--

767−-- instance 'ToForm' Project where

768−-- 'toForm' = 'genericToForm' myOptions

769−--

770−-- instance 'FromForm' Project where

771−-- 'fromForm' = 'genericFromForm' myOptions

772−-- @

773−--

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

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

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

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

778data FormOptions = FormOptions

554data FormOptions = FormOptions

779 { -- | Function applied to field labels. Handy for removing common record prefixes for example.

555 { -- | Function applied to field labels. Handy for removing common record prefixes for example.

780 fieldLabelModifier :: String -> String

556 fieldLabelModifier :: String -> String

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

791defaultFormOptions = FormOptions

567defaultFormOptions = FormOptions

792 { fieldLabelModifier = id

568 { fieldLabelModifier = id

793 }

569 }

794−

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

796−sortOn f = sortBy (comparing f)

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

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

1−{-# LANGUAGE CPP #-}

1+{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DefaultSignatures #-}

2+{-# LANGUAGE DefaultSignatures #-}

3−{-# LANGUAGE DeriveDataTypeable #-}

4−{-# LANGUAGE DeriveFoldable #-}

5−{-# LANGUAGE DeriveFunctor #-}

6−{-# LANGUAGE DeriveTraversable #-}

7−{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE FlexibleInstances #-}

8−{-# LANGUAGE KindSignatures #-}

9−{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE OverloadedStrings #-}

10−{-# LANGUAGE PolyKinds #-}

11−{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TypeSynonymInstances #-}

6{-# LANGUAGE TypeSynonymInstances #-}

13-- |

7-- |

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

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

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

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

16module Web.Internal.HttpApiData where

10module Web.Internal.HttpApiData where

18−import Prelude ()

12+#if __GLASGOW_HASKELL__ < 710

19−import Prelude.Compat

20−

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

13+import Control.Applicative

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

15+#endif

16+

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

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

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

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

24−import qualified Data.Attoparsec.Text as Atto

19+

25−import qualified Data.Attoparsec.Time as Atto

20+import Data.Monoid

26−import Data.ByteString (ByteString)

21+import Data.ByteString (ByteString)

27−import qualified Data.ByteString as BS

22+import qualified Data.ByteString as BS

28−import qualified Data.ByteString.Builder as BS

23+

29−import qualified Data.ByteString.Lazy as LBS

24+import Data.Int

30−import Data.Coerce (coerce)

25+import Data.Word

31−import Data.Data (Data)

26+

32−import qualified Data.Fixed as F

27+import Data.Text (Text)

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

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

35−import Data.Kind (Type)

36−import qualified Data.Map as Map

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

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

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

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

41−import qualified Data.Semigroup as Semi

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

43−import Data.Text (Text)

44−import qualified Data.Text as T

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

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

46− encodeUtf8)

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

48−import qualified Data.Text.Lazy as L

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

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

50− signed)

30+import qualified Data.Text as T

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

31+import qualified Data.Text.Lazy as L

52− NominalDiffTime, TimeOfDay,

32+

53− UTCTime, ZonedTime, formatTime,

54− DayOfWeek (..),

55− nominalDiffTimeToSeconds,

56− secondsToNominalDiffTime)

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

58− iso8601DateFormat)

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

33+import Data.Time.Locale.Compat

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

34+import Data.Time

61− toYearQuarter)

62−import Data.Typeable (Typeable)

63−import qualified Data.UUID.Types as UUID

64−import Data.Version (Version, parseVersion,

35+import Data.Version

65− showVersion)

36+

66−import Data.Void (Void, absurd)

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

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

38+import Data.Void

68−import qualified Network.HTTP.Types as H

69−import Numeric.Natural (Natural)

39+import Numeric.Natural

40+#endif

41+

42+import Text.Read (readMaybe)

70−import Text.ParserCombinators.ReadP (readP_to_S)

43+import Text.ParserCombinators.ReadP (readP_to_S)

71−import Text.Read (readMaybe)

72−import Web.Cookie (SetCookie, parseSetCookie,

73− renderSetCookie)

75#if USE_TEXT_SHOW

45#if USE_TEXT_SHOW

76−import TextShow (TextShow, showt)

46+import TextShow (TextShow, showt)

77#endif

47#endif

79-- $setup

49-- $setup

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

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

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

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

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

83−-- >>> import Data.Version

85-- | Convert value to HTTP API data.

53-- | Convert value to HTTP API data.

86--

54--

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

92 toUrlPiece :: a -> Text

60 toUrlPiece :: a -> Text

93 toUrlPiece = toQueryParam

61 toUrlPiece = toQueryParam

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

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

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

98− toEncodedUrlPiece :: a -> BS.Builder

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

100−

101 -- | Convert to HTTP header value.

63 -- | Convert to HTTP header value.

102 toHeader :: a -> ByteString

64 toHeader :: a -> ByteString

103 toHeader = encodeUtf8 . toUrlPiece

65 toHeader = encodeUtf8 . toUrlPiece

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

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

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

339-- Right True

301-- Right True

340--

302--

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

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

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

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

343parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf

305parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf

344

306

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

383-- Right 1991-06-02

345-- Right 1991-06-02

384--

346--

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

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

386−-- in presence of letters:

348+-- in presense of letters:

387--

349--

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

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

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

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

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

415 l = toInteger (minBound :: a)

377 l = toInteger (minBound :: a)

416 h = toInteger (maxBound :: a)

378 h = toInteger (maxBound :: a)

417

379

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

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

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

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

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

423−unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece

424−

425-- |

380-- |

426-- >>> toUrlPiece ()

381-- >>> toUrlPiece ()

427-- "_"

382-- "_"

428instance ToHttpApiData () where

383instance ToHttpApiData () where

429 toUrlPiece () = "_"

384 toUrlPiece () = "_"

430− toEncodedUrlPiece = unsafeToEncodedUrlPiece

431

385

432−instance ToHttpApiData Char where

386+instance ToHttpApiData Char where toUrlPiece = T.singleton

433− toUrlPiece = T.singleton

434

387

435-- |

388-- |

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

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

437-- "1.2.3"

390-- "1.2.3"

438instance ToHttpApiData Version where

391instance ToHttpApiData Version where

439 toUrlPiece = T.pack . showVersion

392 toUrlPiece = T.pack . showVersion

440− toEncodedUrlPiece = unsafeToEncodedUrlPiece

441

393

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

442instance ToHttpApiData Void where toUrlPiece = absurd

395instance ToHttpApiData Void where toUrlPiece = absurd

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

396+instance ToHttpApiData Natural where toUrlPiece = showt

444−

397+#endif

398+

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

399+instance ToHttpApiData Bool where toUrlPiece = showTextData

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

400+instance ToHttpApiData Ordering where toUrlPiece = showTextData

447−

401+

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

402+instance ToHttpApiData Double where toUrlPiece = showt

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

403+instance ToHttpApiData Float where toUrlPiece = showt

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

404+instance ToHttpApiData Int where toUrlPiece = showt

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

405+instance ToHttpApiData Int8 where toUrlPiece = showt

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

406+instance ToHttpApiData Int16 where toUrlPiece = showt

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

407+instance ToHttpApiData Int32 where toUrlPiece = showt

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

408+instance ToHttpApiData Int64 where toUrlPiece = showt

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

409+instance ToHttpApiData Integer where toUrlPiece = showt

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

410+instance ToHttpApiData Word where toUrlPiece = showt

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

411+instance ToHttpApiData Word8 where toUrlPiece = showt

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

412+instance ToHttpApiData Word16 where toUrlPiece = showt

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

413+instance ToHttpApiData Word32 where toUrlPiece = showt

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

414+instance ToHttpApiData Word64 where toUrlPiece = showt

461−

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

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

464

415

465-- |

416-- |

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

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

467-- "2015-10-03"

418-- "2015-10-03"

468−instance ToHttpApiData Day where

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

469− toUrlPiece = T.pack . show

470− toEncodedUrlPiece = unsafeToEncodedUrlPiece

471

420

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

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

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

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

474

423

475-- |

424-- |

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

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

477−-- "14:55:23.1"

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

478−instance ToHttpApiData TimeOfDay where

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

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

480− toEncodedUrlPiece = unsafeToEncodedUrlPiece

481

428

482-- |

429-- |

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

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

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

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

485−instance ToHttpApiData LocalTime where

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

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

487− toEncodedUrlPiece = unsafeToEncodedUrlPiece

488

433

489-- |

434-- |

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

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

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

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

492−instance ToHttpApiData ZonedTime where

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

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

494− toEncodedUrlPiece = unsafeToEncodedUrlPiece

495

438

496−-- |

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

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"

520−instance ToHttpApiData QuarterOfYear where

521− toUrlPiece Q1 = "q1"

522− toUrlPiece Q2 = "q2"

523− toUrlPiece Q3 = "q3"

524− toUrlPiece Q4 = "q4"

525−

526−-- |

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

528−-- >>> MkQuarter 8040

529−-- 2010-Q1

530−--

531−-- >>> toUrlPiece $ MkQuarter 8040

532−-- "2010-q1"

533−--

534−instance ToHttpApiData Quarter where

535− toUrlPiece q = case toYearQuarter q of

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

537− where

538− f Q1 = "q1"

539− f Q2 = "q2"

540− f Q3 = "q3"

541− f Q4 = "q4"

542−

543−-- |

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

545−-- >>> MkMonth 24482

546−-- 2040-03

547−--

548−-- >>> toUrlPiece $ MkMonth 24482

549−-- "2040-03"

550−--

551−instance ToHttpApiData Month where

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

553−

554−instance ToHttpApiData NominalDiffTime where

555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds

556− toEncodedUrlPiece = unsafeToEncodedUrlPiece

557

440

558instance ToHttpApiData String where toUrlPiece = T.pack

441instance ToHttpApiData String where toUrlPiece = T.pack

559instance ToHttpApiData Text where toUrlPiece = id

442instance ToHttpApiData Text where toUrlPiece = id

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

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

561

444

562−instance ToHttpApiData All where

445+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll

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

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

565−

566−instance ToHttpApiData Any where

446+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny

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

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

569−

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

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

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

573−

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

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

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

577−

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

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

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

581−

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

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

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

585

447

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

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

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

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

589−

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

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

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

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

593−

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

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

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

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

597−

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

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

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

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

601−

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

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

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

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

605

453

606-- |

454-- |

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

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

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

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

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

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

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

621

469

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

623−--

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

625−-- >>> toUrlPiece c

626−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

627−--

628−-- >>> toHeader c

629−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

630−--

631−instance ToHttpApiData SetCookie where

632− toUrlPiece = decodeUtf8With lenientDecode . toHeader

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

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

635−

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

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

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

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

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

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

642−

643−-- | @since 0.4.2

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

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

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

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

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

649−

650−-- | @since 0.4.2

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

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

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

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

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

656−

657-- |

470-- |

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

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

659-- Right ()

472-- Right ()

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

665 parseUrlPiece s =

478 parseUrlPiece s =

666 case T.uncons s of

479 case T.uncons s of

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

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

668− _ -> defaultParseError s

481+ _ -> defaultParseError s

669

482

670-- |

483-- |

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

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

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

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

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

677 _ -> defaultParseError s

490 _ -> defaultParseError s

678

491

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

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

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

680instance FromHttpApiData Void where

494instance FromHttpApiData Void where

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

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

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

684 parseUrlPiece s = do

498 parseUrlPiece s = do

685 n <- runReader (signed decimal) s

499 n <- runReader (signed decimal) s

686 if n < 0

500 if n < 0

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

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

688 else Right (fromInteger n)

502 else Right (fromInteger n)

503+#endif

689

504

690instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

505instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

691instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

506instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

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

706instance FromHttpApiData Text where parseUrlPiece = Right

521instance FromHttpApiData Text where parseUrlPiece = Right

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

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

708

523

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

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

711− parseUrlPiece = runReader rational

712−

713-- |

524-- |

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

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

715-- Right (2016,12,1)

526-- Right (2016,12,1)

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

527+instance FromHttpApiData Day where parseUrlPiece = readTextData

717

528

718−-- |

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

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

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

720−-- Right 14:55:01.333

531+ where

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

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

722

533

723-- |

534-- |

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

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

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

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

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

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

727

538

728-- |

539-- |

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

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

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

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

731−--

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

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

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

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

735

543

736-- |

544-- |

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

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

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

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

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

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

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

754

548

755−-- |

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

757−-- Right 2021-01

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

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

759

550

760−-- |

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

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

762−-- Right 2021-Q1

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

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

764

553

765−-- |

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

767−-- Right Q2

768−--

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

770−-- Right Q3

771−instance FromHttpApiData QuarterOfYear where

772− parseUrlPiece t = case T.toLower t of

773− "q1" -> return Q1

774− "q2" -> return Q2

775− "q3" -> return Q3

776− "q4" -> return Q4

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

778−

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

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

781−

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

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

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

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

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

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

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

557+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . 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)

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

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

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

792

559

793-- |

560-- |

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

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

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

810 Left _ <!> y = y

577 Left _ <!> y = y

811 x <!> _ = x

578 x <!> _ = x

812

579

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.yamlnew file+11

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

1+resolver: lts-6.8

3+packages:

4+- '.'

6+flags:

7+ http-api-data:

8+ use-text-show: false

10+extra-deps: []

11+extra-package-dbs: []

stack-ghc-7.8.yamlnew file+23

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

1+resolver: lts-2.22

3+packages:

4+- '.'

6+flags:

7+ http-api-data:

8+ use-text-show: false

10+extra-deps:

11+- time-locale-compat-0.1.1.3

12+- uri-bytestring-0.2.2.0

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

14+- text-show-2.1.2

15+- base-compat-0.9.1

16+- bifunctors-5.2

17+- semigroups-0.16.2.2

18+- th-lift-0.7.6

19+- transformers-compat-0.4.0.4

20+- base-orphans-0.5.4

21+- generic-deriving-1.9.0

22+- doctest-0.11.0

23+extra-package-dbs: []

stack.yaml+6−1

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

1−resolver: lts-12.10

1+resolver: nightly-2016-07-19

2packages:

3packages:

3- '.'

4- '.'

4flags:

6flags:

5 http-api-data:

7 http-api-data:

6 use-text-show: false

8 use-text-show: false

10+extra-deps: []

11+extra-package-dbs: []

test/DocTest.hsnew file+30

@@ -0,0 +1,30 @@

1+module Main where

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+ : ("-i" ++ autogen_dir)

15+ : "-optP-include"

16+ : ("-optP" ++ autogen_dir ++ "/cabal_macros.h")

17+ : "-hide-all-packages"

18+ : map ("-package="++) deps ++ sources

19+

20+getSources :: IO [FilePath]

21+getSources = filter (isSuffixOf ".hs") <$> go "src"

22+ where

23+ go dir = do

24+ (dirs, files) <- getFilesAndDirectories dir

25+ (files ++) . concat <$> mapM go dirs

26+

27+getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])

28+getFilesAndDirectories dir = do

29+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir

30+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

test/Web/Internal/HttpApiDataSpec.hs+23−70

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE ScopedTypeVariables #-}

2{-# LANGUAGE ScopedTypeVariables #-}

2module Web.Internal.HttpApiDataSpec (spec) where

3module 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

5−import Prelude ()

13+import Data.Proxy

6−import Prelude.Compat

8−import qualified Data.ByteString as BS

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

9−import Data.ByteString.Builder (toLazyByteString)

16+import Numeric.Natural

10−import Data.Char

17+#endif

11−import qualified Data.Fixed as F

12−import Data.Int

13−import qualified Data.Text as T

14−import qualified Data.Text.Encoding as TE

15−import qualified Data.Text.Lazy as L

16−import Data.Time.Compat

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

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

19−import qualified Data.UUID.Types as UUID

20−import Data.Version

21−import Data.Word

22−import Web.Cookie (SetCookie, defaultSetCookie,

23− setCookieName, setCookieValue)

25−import Data.Proxy

19+import Test.Hspec

20+import Test.Hspec.QuickCheck(prop)

21+import Test.QuickCheck

27−import Numeric.Natural

23+import Web.Internal.HttpApiData

29−import Test.Hspec

25+import Web.Internal.TestInstances

30−import Test.Hspec.QuickCheck (prop)

31−import Test.QuickCheck

33−import Web.Internal.HttpApiData

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

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

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

30checkUrlPiece :: 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

55− prop "toUrlPiece <=> parseUrlPiece" $ forAll gen (toUrlPiece <=> parseUrlPiece :: a -> Property)

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

56− prop "toQueryParam <=> parseQueryParam" $ forAll gen (toQueryParam <=> parseQueryParam :: a -> Property)

57− prop "toHeader <=> parseHeader" $ forAll gen (toHeader <=> parseHeader :: a -> Property)

58− prop "toEncodedUrlPiece encodes correctly" $ forAll gen encodedUrlPieceProp

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

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

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

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

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

64spec :: Spec

37spec :: Spec

65spec = do

38spec = do

66− describe "Instances" $ do

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

62 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"

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

63 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

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

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

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

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

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

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

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

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

112

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

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

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

72+#endif

114

115 it "bad integers are rejected" $ do

74 it "bad integers are rejected" $ do

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

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

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

121

122 it "invalid utf8 is handled" $ do

81 it "invalid utf8 is handled" $ do

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

82 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+38−2

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

9 ) where

11import Control.Applicative

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

12import Data.Char

13import Data.Char

13import qualified Data.HashMap.Strict as HashMap

14import qualified Data.HashMap.Strict as HashMap

14import qualified Data.Text as T

15import qualified Data.Text as T

16+import qualified Data.Text.Lazy as L

15−import Data.Time.Compat

17+import Data.Time

18+import Data.Version

16import GHC.Exts (fromList)

19import GHC.Exts (fromList)

17import GHC.Generics

20import GHC.Generics

19import Test.QuickCheck

22import Test.QuickCheck

20−import Test.QuickCheck.Instances ()

22import Web.Internal.FormUrlEncoded

24import Web.Internal.FormUrlEncoded

23import Web.Internal.HttpApiData

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

25instance Eq ZonedTime where

44instance Eq ZonedTime where

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

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

28instance Arbitrary Form where

64instance Arbitrary Form where

29 arbitrary = fromList <$> arbitrary

65 arbitrary = fromList <$> arbitrary