git.iko.soy/typeable/http-api-data
on master help sign in
8 files changed+246−86
since splitsnapshots
unifiedsplit
.ghci−1 .github/workflows/haskell-ci.yml+126−41 CHANGELOG.md+13 cabal.haskell-ci+2−1 http-api-data.cabal+23−34 src/Web/Internal/FormUrlEncoded.hs+8 src/Web/Internal/HttpApiData.hs+68−9 test/Web/Internal/HttpApiDataSpec.hs+6
.ghcideleted−1
@@ -1 +0,0 @@
1−:set -itest -isrc -optP-include -optP .stack-work/dist/x86_64-osx/Cabal-1.24.0.0/build/autogen/cabal_macros.h -optP-I -optPinclude
.github/workflows/haskell-ci.yml+126−41
@@ -8,9 +8,9 @@
88#
99# For more information, see https://github.com/haskell-CI/haskell-ci
1010#
11−# version: 0.11.20210101
11+# version: 0.15.20220609
1212#
13−# REGENDATA ("0.11.20210101",["github","cabal.project"])
13+# REGENDATA ("0.15.20220609",["github","cabal.project"])
1414#
1515name: Haskell-CI
1616on:
@@ -22,60 +22,119 @@ on:
2222 - master
2323jobs:
2424 linux:
25− name: Haskell-CI Linux - GHC ${{ matrix.ghc }}
26− runs-on: ubuntu-18.04
25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}
26+ runs-on: ubuntu-20.04
27+ timeout-minutes:
28+ 60
2729 container:
2830 image: buildpack-deps:bionic
2931 continue-on-error: ${{ matrix.allow-failure }}
3032 strategy:
3133 matrix:
3234 include:
33− - ghc: 8.10.3
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
3444 allow-failure: false
35− - ghc: 8.8.4
45+ - compiler: ghc-9.0.2
46+ compilerKind: ghc
47+ compilerVersion: 9.0.2
48+ setup-method: ghcup
3649 allow-failure: false
37− - ghc: 8.6.5
50+ - compiler: ghc-8.10.7
51+ compilerKind: ghc
52+ compilerVersion: 8.10.7
53+ setup-method: ghcup
3854 allow-failure: false
39− - ghc: 8.4.4
55+ - compiler: ghc-8.8.4
56+ compilerKind: ghc
57+ compilerVersion: 8.8.4
58+ setup-method: hvr-ppa
4059 allow-failure: false
41− - ghc: 8.2.2
60+ - compiler: ghc-8.6.5
61+ compilerKind: ghc
62+ compilerVersion: 8.6.5
63+ setup-method: hvr-ppa
4264 allow-failure: false
43− - ghc: 8.0.2
65+ - compiler: ghc-8.4.4
66+ compilerKind: ghc
67+ compilerVersion: 8.4.4
68+ setup-method: hvr-ppa
4469 allow-failure: false
45− - ghc: 7.10.3
70+ - compiler: ghc-8.2.2
71+ compilerKind: ghc
72+ compilerVersion: 8.2.2
73+ setup-method: hvr-ppa
4674 allow-failure: false
47− - ghc: 7.8.4
75+ - compiler: ghc-8.0.2
76+ compilerKind: ghc
77+ compilerVersion: 8.0.2
78+ setup-method: hvr-ppa
4879 allow-failure: false
4980 fail-fast: false
5081 steps:
5182 - name: apt
5283 run: |
5384 apt-get update
54− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
55− apt-add-repository -y 'ppa:hvr/ghc'
56− apt-get update
57− apt-get install -y ghc-$GHC_VERSION cabal-install-3.2
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
58102 env:
59− GHC_VERSION: ${{ matrix.ghc }}
103+ HCKIND: ${{ matrix.compilerKind }}
104+ HCNAME: ${{ matrix.compiler }}
105+ HCVER: ${{ matrix.compilerVersion }}
60106 - name: Set PATH and environment variables
61107 run: |
62108 echo "$HOME/.cabal/bin" >> $GITHUB_PATH
63− echo "LANG=C.UTF-8" >> $GITHUB_ENV
64− echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
65− echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV
66− HC=/opt/ghc/$GHC_VERSION/bin/ghc
67− echo "HC=$HC" >> $GITHUB_ENV
68− echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV
69− echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV
70− echo "CABAL=/opt/cabal/3.2/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
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+
71127 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
72− echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
73− echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
74− echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
75− echo "ARG_COMPILER=--ghc --with-compiler=/opt/ghc/$GHC_VERSION/bin/ghc" >> $GITHUB_ENV
76− echo "GHCJSARITH=0" >> $GITHUB_ENV
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"
77134 env:
78− GHC_VERSION: ${{ matrix.ghc }}
135+ HCKIND: ${{ matrix.compilerKind }}
136+ HCNAME: ${{ matrix.compiler }}
137+ HCVER: ${{ matrix.compilerVersion }}
79138 - name: env
80139 run: |
81140 env
@@ -98,6 +157,22 @@ jobs:
98157 repository hackage.haskell.org
99158 url: http://hackage.haskell.org/
100159 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
101176 cat $CABAL_CONFIG
102177 - name: versions
103178 run: |
@@ -110,7 +185,7 @@ jobs:
110185 - name: cache (tools)
111186 uses: actions/cache@v2
112187 with:
113− key: ${{ runner.os }}-${{ matrix.ghc }}-tools-9caa866f
188+ key: ${{ runner.os }}-${{ matrix.compiler }}-tools-445c2459
114189 path: ~/.haskell-ci-tools
115190 - name: install cabal-plan
116191 run: |
@@ -123,16 +198,20 @@ jobs:
123198 cabal-plan --version
124199 - name: install doctest
125200 run: |
126− if [ $((HCNUMVER >= 80000 && HCNUMVER < 81000)) -ne 0 ] ; then $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.17' ; fi
127− if [ $((HCNUMVER >= 80000 && HCNUMVER < 81000)) -ne 0 ] ; then doctest --version ; fi
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
128203 - name: checkout
129204 uses: actions/checkout@v2
130205 with:
131206 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
132212 - name: sdist
133213 run: |
134214 mkdir -p sdist
135− cd source || false
136215 $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
137216 - name: unpack
138217 run: |
@@ -141,7 +220,8 @@ jobs:
141220 - name: generate cabal.project
142221 run: |
143222 PKGDIR_http_api_data="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/http-api-data-[0-9.]*')"
144− echo "PKGDIR_http_api_data=${PKGDIR_http_api_data}" >> $GITHUB_ENV
223+ echo "PKGDIR_http_api_data=${PKGDIR_http_api_data}" >> "$GITHUB_ENV"
224+ rm -f cabal.project cabal.project.local
145225 touch cabal.project
146226 touch cabal.project.local
147227 echo "packages: ${PKGDIR_http_api_data}" >> cabal.project
@@ -149,6 +229,9 @@ jobs:
149229 if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi
150230 cat >> cabal.project <<EOF
151231 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
152235 $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(http-api-data)$/; }' >> cabal.project.local
153236 cat cabal.project
154237 cat cabal.project.local
@@ -159,9 +242,9 @@ jobs:
159242 - name: cache
160243 uses: actions/cache@v2
161244 with:
162− key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}
245+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
163246 path: ~/.cabal/store
164− restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
247+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
165248 - name: install dependencies
166249 run: |
167250 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
@@ -177,15 +260,16 @@ jobs:
177260 $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
178261 - name: doctest
179262 run: |
180− if [ $((HCNUMVER >= 80000 && HCNUMVER < 81000)) -ne 0 ] ; then cd ${PKGDIR_http_api_data} || false ; fi
181− if [ $((HCNUMVER >= 80000 && HCNUMVER < 81000)) -ne 0 ] ; then doctest src/ ; fi
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
182266 - name: cabal check
183267 run: |
184268 cd ${PKGDIR_http_api_data} || false
185269 ${CABAL} -vnormal check
186270 - name: haddock
187271 run: |
188− $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
272+ $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
189273 - name: unconstrained build
190274 run: |
191275 rm -f cabal.project.local
@@ -195,4 +279,5 @@ jobs:
195279 rm -f cabal.project.local
196280 - name: constraint set text-show
197281 run: |
282+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='http-api-data +use-text-show' --dependencies-only -j2 all
198283 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='http-api-data +use-text-show' all
CHANGELOG.md+13
@@ -1,3 +1,16 @@
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+
1140.4.2
215-----
316
cabal.haskell-ci+2−1
@@ -1,5 +1,6 @@
11branches: master
2−doctest: <8.10
2+doctest: <9
3+doctest-filter-packages: base-compat
34
45constraint-set text-show
56 constraints: http-api-data +use-text-show
http-api-data.cabal+23−34
@@ -1,6 +1,6 @@
11cabal-version: >= 1.10
22name: http-api-data
3−version: 0.4.2
3+version: 0.5
44
55synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters.
66category: Web
@@ -24,14 +24,15 @@ extra-source-files:
2424 README.md
2525
2626tested-with:
27− GHC==7.8.4,
28− GHC==7.10.3,
2927 GHC==8.0.2,
3028 GHC==8.2.2,
3129 GHC==8.4.4,
3230 GHC==8.6.5,
3331 GHC==8.8.4,
34− GHC==8.10.3
32+ GHC==8.10.7,
33+ GHC==9.0.2,
34+ GHC==9.2.3,
35+ GHC==9.4.1
3536
3637flag use-text-show
3738 description: Use text-show library for efficient ToHttpApiData implementations.
@@ -43,40 +44,28 @@ library
4344 include-dirs: include/
4445
4546 -- GHC bundled
46− build-depends: base >= 4.7 && < 4.15
47− , bytestring >= 0.10.4.0 && < 0.11
48− , containers >= 0.5.5.1 && < 0.7
49− , text >= 1.2.3.0 && < 1.3
50− , transformers >= 0.3 && < 0.6
51−
52− -- so Semigroup Builder exists
53− if impl(ghc >= 8.0)
54− build-depends: bytestring >= 0.10.8.1
47+ build-depends: base >= 4.9 && < 4.17
48+ , bytestring >= 0.10.8.1 && < 0.12
49+ , containers >= 0.5.7.1 && < 0.7
50+ , text >= 1.2.3.0 && < 1.3 || >=2.0 && <2.1
51+ , transformers >= 0.5.2.0 && < 0.7
5552
5653 -- other-dependencies
5754 build-depends:
58− attoparsec >= 0.13.2.2 && < 0.14
59− , attoparsec-iso8601 >= 1.0.1.0 && < 1.1
60− , base-compat >= 0.10.5 && < 0.12
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
6158 , cookie >= 0.4.3 && < 0.5
62− , hashable >= 1.2.7.0 && < 1.4
59+ , hashable >= 1.2.7.0 && < 1.5
6360 , http-types >= 0.12.3 && < 0.13
6461 , tagged >= 0.8.5 && < 0.9
65− , time-compat >= 1.9.2 && < 1.10
66− , unordered-containers >= 0.2.10.0 && < 0.3
67− , uuid-types >= 1.0.3 && <1.1
68−
69− if !impl(ghc >= 7.10)
70− build-depends:
71− nats >= 1.1.2 && < 1.2,
72− void >= 0.7.3 && < 0.8
73−
74− if !impl(ghc >= 8.0)
75− build-depends: semigroups >= 0.18.5 && < 0.20
62+ , time-compat >= 1.9.5 && < 1.10
63+ , unordered-containers >= 0.2.10.0 && < 0.3
64+ , uuid-types >= 1.0.3 && < 1.1
7665
7766 if flag(use-text-show)
7867 cpp-options: -DUSE_TEXT_SHOW
79− build-depends: text-show >= 3.8.2 && <3.9
68+ build-depends: text-show >= 3.8.2 && <3.10
8069
8170 exposed-modules:
8271 Web.HttpApiData
@@ -96,7 +85,7 @@ test-suite spec
9685 hs-source-dirs: test
9786 ghc-options: -Wall
9887 default-language: Haskell2010
99− build-tool-depends: hspec-discover:hspec-discover >= 2.7.1 && <2.8
88+ build-tool-depends: hspec-discover:hspec-discover >= 2.7.1 && <2.11
10089 -- inherited depndencies
10190 build-depends:
10291 base
@@ -112,10 +101,10 @@ test-suite spec
112101 if !impl(ghc >= 7.10)
113102 build-depends: nats
114103
115− build-depends: HUnit >= 1.6.0.0 && <1.7
116− , hspec >= 2.7.1 && <2.8
117− , QuickCheck >= 2.13.1 && <2.15
118− , quickcheck-instances >= 0.3.21 && <0.4
104+ build-depends: HUnit >= 1.6.0.0 && <1.7
105+ , hspec >= 2.7.1 && <2.11
106+ , QuickCheck >= 2.13.1 && <2.15
107+ , quickcheck-instances >= 0.3.25.2 && <0.4
119108
120109source-repository head
121110 type: git
src/Web/Internal/FormUrlEncoded.hs+8
@@ -52,6 +52,8 @@ import Data.Text.Encoding.Error (lenientDecode)
5252import qualified Data.Text.Lazy as Lazy
5353import Data.Time.Compat (Day, LocalTime, NominalDiffTime,
5454 UTCTime, ZonedTime)
55+import Data.Time.Calendar.Month.Compat (Month)
56+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
5557import Data.Void (Void)
5658import Data.Word (Word16, Word32, Word64, Word8)
5759import GHC.Exts (Constraint, IsList (..))
@@ -113,6 +115,9 @@ instance ToFormKey LocalTime where toFormKey = toQueryParam
113115instance ToFormKey ZonedTime where toFormKey = toQueryParam
114116instance ToFormKey UTCTime where toFormKey = toQueryParam
115117instance 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
116121
117122instance ToFormKey String where toFormKey = toQueryParam
118123instance ToFormKey Text where toFormKey = toQueryParam
@@ -172,6 +177,9 @@ instance FromFormKey LocalTime where parseFormKey = parseQueryParam
172177instance FromFormKey ZonedTime where parseFormKey = parseQueryParam
173178instance FromFormKey UTCTime where parseFormKey = parseQueryParam
174179instance 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
175183
176184instance FromFormKey String where parseFormKey = parseQueryParam
177185instance FromFormKey Text where parseFormKey = parseQueryParam
src/Web/Internal/HttpApiData.hs+68−9
@@ -32,6 +32,7 @@ import Data.Data (Data)
3232import qualified Data.Fixed as F
3333import Data.Functor.Identity (Identity(Identity))
3434import Data.Int (Int16, Int32, Int64, Int8)
35+import Data.Kind (Type)
3536import qualified Data.Map as Map
3637import Data.Monoid (All (..), Any (..), Dual (..),
3738 First (..), Last (..),
@@ -55,6 +56,9 @@ import Data.Time.Compat (Day, FormatTime, LocalTime,
5556 secondsToNominalDiffTime)
5657import Data.Time.Format.Compat (defaultTimeLocale,
5758 iso8601DateFormat)
59+import Data.Time.Calendar.Month.Compat (Month)
60+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
61+ toYearQuarter)
5862import Data.Typeable (Typeable)
5963import qualified Data.UUID.Types as UUID
6064import Data.Version (Version, parseVersion,
@@ -68,12 +72,6 @@ import Text.Read (readMaybe)
6872import Web.Cookie (SetCookie, parseSetCookie,
6973 renderSetCookie)
7074
71−#if MIN_VERSION_base(4,9,0)
72−import Data.Kind (Type)
73−#else
74−#define Type *
75−#endif
76−
7775#if USE_TEXT_SHOW
7876import TextShow (TextShow, showt)
7977#endif
@@ -98,7 +96,7 @@ class ToHttpApiData a where
9896 -- The default definition uses 'H.encodePathSegmentsRelative',
9997 -- but this may be overriden with a more efficient version.
10098 toEncodedUrlPiece :: a -> BS.Builder
101− toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece
99+ toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
102100
103101 -- | Convert to HTTP header value.
104102 toHeader :: a -> ByteString
@@ -516,6 +514,42 @@ instance ToHttpApiData DayOfWeek where
516514
517515 toEncodedUrlPiece = unsafeToEncodedUrlPiece
518516
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"
519553
520554instance ToHttpApiData NominalDiffTime where
521555 toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
@@ -704,6 +738,9 @@ instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
704738-- Right 2015-10-03 00:14:24 UTC
705739instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
706740
741+-- |
742+-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
743+-- Right Monday
707744instance FromHttpApiData DayOfWeek where
708745 parseUrlPiece t = case Map.lookup (T.toLower t) m of
709746 Just dow -> Right dow
@@ -715,6 +752,30 @@ instance FromHttpApiData DayOfWeek where
715752
716753instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
717754
755+-- |
756+-- >>> parseUrlPiece "2021-01" :: Either Text Month
757+-- Right 2021-01
758+instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month
759+
760+-- |
761+-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter
762+-- Right 2021-Q1
763+instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter
764+
765+-- |
766+-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear
767+-- Right Q2
768+--
769+-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear
770+-- Right Q3
771+instance FromHttpApiData QuarterOfYear where
772+ parseUrlPiece t = case T.toLower t of
773+ "q1" -> return Q1
774+ "q2" -> return Q2
775+ "q3" -> return Q3
776+ "q4" -> return Q4
777+ _ -> Left "Invalid quarter of year"
778+
718779instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
719780instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
720781
@@ -804,5 +865,3 @@ runAtto :: Atto.Parser a -> Text -> Either Text a
804865runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
805866 Left err -> Left (T.pack err)
806867 Right x -> Right x
807−
808−
test/Web/Internal/HttpApiDataSpec.hs+6
@@ -14,6 +14,8 @@ import qualified Data.Text as T
1414import qualified Data.Text.Encoding as TE
1515import qualified Data.Text.Lazy as L
1616import Data.Time.Compat
17+import Data.Time.Calendar.Month.Compat (Month)
18+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
1719import qualified Data.UUID.Types as UUID
1820import Data.Version
1921import Data.Word
@@ -87,6 +89,10 @@ spec = do
8789 checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
8890 checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
8991 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"
9096 checkUrlPiece (Proxy :: Proxy Version) "Version"
9197 checkUrlPiece (Proxy :: Proxy UUID.UUID) "UUID"
9298 checkUrlPiece' setCookieGen "Cookie"