f7876c3 · typeable/http-api-data

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

Merge pull request #89 from fizruk/prepare-0.4

Prepare 0.4

commitf7876c300046d9ebd288fa656cdd3aa7ea234235 authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 13 Nov 2018, 14:17 (8 years ago) parent283c747 6454ed0

6 files changed+218−166

compare with master

unifiedsplit

.travis.yml+6−7 CHANGELOG.md+7 http-api-data.cabal+19−10 src/Web/Internal/FormUrlEncoded.hs+36−31 src/Web/Internal/HttpApiData.hs+119−61 test/Web/Internal/HttpApiDataSpec.hs+31−57

.travis.yml+6−7

@@ -32,12 +32,12 @@ before_cache:

3232

3333matrix:

3434 include:

35− - compiler: "ghc-8.6.1"

35+ - compiler: "ghc-8.6.2"

3636 # env: TEST=--disable-tests BENCH=--disable-benchmarks

37− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}}

38− - compiler: "ghc-8.4.3"

37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.2], sources: [hvr-ghc]}}

38+ - compiler: "ghc-8.4.4"

3939 # env: TEST=--disable-tests BENCH=--disable-benchmarks

40− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.3], sources: [hvr-ghc]}}

40+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}

4141 - compiler: "ghc-8.2.2"

4242 # env: TEST=--disable-tests BENCH=--disable-benchmarks

4343 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}

@@ -93,8 +93,8 @@ install:

9393# any command which exits with a non-zero exit code causes the build to fail.

9494script:

9595 # test that source-distributions can be generated

96− - (cd "." && cabal sdist)

97− - mv "."/dist/http-api-data-*.tar.gz ${DISTDIR}/

96+ - cabal new-sdist all

97+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

9898 - cd ${DISTDIR} || false

9999 - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

100100 - "printf 'packages: http-api-data-*/*.cabal\\n' > cabal.project"

@@ -113,7 +113,6 @@ script:

113113 - (cd http-api-data-* && cabal check)

114114

115115 # haddock

116− - rm -rf ./dist-newstyle

117116 - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

118117

119118 # Build without installed constraints for packages in global-db

CHANGELOG.md+7

@@ -1,3 +1,10 @@

1+0.4

2+---

4+* `NominalDiffTime` instances preserve precision (roundtrip)

5+* Add `Semigroup.Min`, `Max`, `First`, `Last` instances

6+* Add `Tagged b a` instances

180.3.10

29---

310

http-api-data.cabal+19−10

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

11cabal-version: >= 1.10

22name: http-api-data

3−version: 0.3.10

3+version: 0.4

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

66category: Web

@@ -22,13 +22,14 @@ extra-source-files:

2222 test/*.hs

2323 CHANGELOG.md

2424 README.md

25+

2526tested-with:

2627 GHC==7.8.4,

2728 GHC==7.10.3,

2829 GHC==8.0.2,

2930 GHC==8.2.2,

30− GHC==8.4.3,

31− GHC==8.6.1

31+ GHC==8.4.4,

32+ GHC==8.6.2

3233

3334custom-setup

3435 setup-depends:

@@ -55,14 +56,21 @@ library

5556 -- other-dependencies

5657 build-depends:

5758 attoparsec >= 0.13.2.2 && < 0.14

58− , attoparsec-iso8601 >= 1.0.0.0 && < 1.1

59+ , attoparsec-iso8601 >= 1.0.1.0 && < 1.1

60+ , base-compat >= 0.10.5 && < 0.11

5961 , cookie >= 0.4.3 && < 0.4.5

6062 , hashable >= 1.2.7.0 && < 1.3

61− , http-types >= 0.12.1 && < 0.13

63+ , http-types >= 0.12.2 && < 0.13

64+ , tagged >= 0.8.5 && < 0.9

6265 , time-locale-compat >= 0.1.1.5 && < 0.2

6366 , unordered-containers >= 0.2.9.0 && < 0.3

6467 , uuid-types >= 1.0.3 && <1.1

6568

69+ if !impl(ghc >= 7.10)

70+ build-depends:

71+ nats >= 1.1.2 && < 1.2,

72+ void >= 0.7.2 && < 0.8

73+

6674 if !impl(ghc >= 8.0)

6775 build-depends: semigroups >= 0.18.5 && < 0.19

6876

@@ -88,21 +96,22 @@ test-suite spec

8896 hs-source-dirs: test

8997 ghc-options: -Wall

9098 default-language: Haskell2010

91− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.6

99+ build-tool-depends: hspec-discover:hspec-discover >= 2.6.0 && <2.7

92100 -- inherited depndencies

93101 build-depends:

94102 base

103+ , base-compat

95104 , bytestring

96− , unordered-containers

105+ , cookie

97106 , http-api-data

107+ , nats

98108 , text

99109 , time

100− , bytestring

110+ , unordered-containers

101111 , uuid-types

102− , cookie

103112

104113 build-depends: HUnit >= 1.6.0.0 && <1.7

105− , hspec >= 2.5.5 && <2.6

114+ , hspec >= 2.6.0 && <2.7

106115 , QuickCheck >= 2.11.3 && <2.13

107116 , quickcheck-instances >= 0.3.19 && <0.4

108117

src/Web/Internal/FormUrlEncoded.hs+36−31

@@ -17,51 +17,46 @@

1717#include "overlapping-compat.h"

1818module Web.Internal.FormUrlEncoded where

1919

20−#if __GLASGOW_HASKELL__ < 710

21−import Control.Applicative

22−import Data.Traversable

23−#endif

24−

20+import Prelude ()

21+import Prelude.Compat

2522

2623import Control.Arrow ((***))

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

2825import Data.ByteString.Builder (shortByteString, toLazyByteString)

2926import qualified Data.ByteString.Lazy as BSL

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

28+import Data.Coerce (coerce)

3129import qualified Data.Foldable as F

3230import Data.Hashable (Hashable)

3331import Data.HashMap.Strict (HashMap)

3432import qualified Data.HashMap.Strict as HashMap

35−import Data.Int

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

3634import Data.IntMap (IntMap)

3735import qualified Data.IntMap as IntMap

3836import Data.List (intersperse, sortBy)

3937import Data.Map (Map)

4038import qualified Data.Map as Map

41−import Data.Monoid

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

40+ Product (..), Sum (..))

4241import Data.Ord (comparing)

42+import Data.Proxy (Proxy (..))

43+import Data.Semigroup (Semigroup (..))

4344import qualified Data.Semigroup as Semi

44−

45+import Data.Tagged (Tagged (..))

4546import Data.Text (Text)

4647import qualified Data.Text as Text

47−import Data.Text.Encoding as Text

48+import qualified Data.Text.Encoding as Text

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

4950import qualified Data.Text.Lazy as Lazy

50−

51−import Data.Proxy

52−import Data.Time

53−import Data.Word

54−

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

56−import Data.Void

57−import Numeric.Natural

58−#endif

59−

51+import Data.Time (Day, LocalTime, NominalDiffTime,

52+ UTCTime, ZonedTime)

53+import Data.Void (Void)

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

6055import GHC.Exts (Constraint, IsList (..))

6156import GHC.Generics

6257import GHC.TypeLits

6358import Network.HTTP.Types.URI (urlDecode, urlEncodeBuilder)

64−

59+import Numeric.Natural (Natural)

6560import Web.Internal.HttpApiData

6661

6762-- $setup

@@ -124,14 +119,19 @@ instance ToFormKey Lazy.Text where toFormKey = toQueryParam

124119instance ToFormKey All where toFormKey = toQueryParam

125120instance ToFormKey Any where toFormKey = toQueryParam

126121

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

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

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

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

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

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

125+

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

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

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

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

130+

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

130132

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

132133instance ToFormKey Void where toFormKey = toQueryParam

133134instance ToFormKey Natural where toFormKey = toQueryParam

134−#endif

135135

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

137137class FromFormKey k where

@@ -171,20 +171,25 @@ instance FromFormKey Lazy.Text where parseFormKey = parseQueryParam

171171instance FromFormKey All where parseFormKey = parseQueryParam

172172instance FromFormKey Any where parseFormKey = parseQueryParam

173173

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

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

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

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

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

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

177+

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

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

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

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

182+

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

177184

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

179185instance FromFormKey Void where parseFormKey = parseQueryParam

180186instance FromFormKey Natural where parseFormKey = parseQueryParam

181−#endif

182187

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

184189--

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

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

187− deriving (Eq, Read, Generic, Semi.Semigroup, Monoid)

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

188193

189194instance Show Form where

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

src/Web/Internal/HttpApiData.hs+119−61

@@ -13,67 +13,70 @@

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

1414module Web.Internal.HttpApiData where

1515

16−#if __GLASGOW_HASKELL__ < 710

17−import Control.Applicative

18−import Data.Foldable (Foldable)

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

20−#endif

16+import Prelude ()

17+import Prelude.Compat

2118

2219import Control.Arrow (left, (&&&))

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

24−

21+import qualified Data.Attoparsec.Text as Atto

22+import qualified Data.Attoparsec.Time as Atto

2523import Data.ByteString (ByteString)

2624import qualified Data.ByteString as BS

25+import qualified Data.ByteString.Builder as BS

2726import qualified Data.ByteString.Lazy as LBS

28−import Data.Monoid

29−

27+import Data.Coerce (coerce)

28+import Data.Data (Data)

3029import qualified Data.Fixed as F

31−import Data.Int

32−import Data.Word

33−

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

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

32+ First (..), Last (..),

33+ Product (..), Sum (..))

34+import Data.Semigroup (Semigroup (..))

35+import qualified Data.Semigroup as Semi

36+import Data.Tagged (Tagged (..))

3437import Data.Text (Text)

3538import qualified Data.Text as T

36−import Data.Text.Encoding (decodeUtf8With, decodeUtf8', encodeUtf8)

39+import Data.Text.Encoding (decodeUtf8', decodeUtf8With,

40+ encodeUtf8)

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

3842import qualified Data.Text.Lazy as L

3943import Data.Text.Read (Reader, decimal, rational,

4044 signed)

41−

42−import Data.Time

43−#if __GLASGOW_HASKELL__ < 710

44−import Data.Time.Locale.Compat

45−#endif

46−import Data.Version

47−

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

49−import Data.Void

50−import Numeric.Natural

51−#endif

52−

45+import Data.Time (Day, FormatTime, LocalTime,

46+ NominalDiffTime, TimeOfDay,

47+ UTCTime, ZonedTime, formatTime)

48+import Data.Time.Locale.Compat (defaultTimeLocale,

49+ iso8601DateFormat)

50+import Data.Typeable (Typeable)

51+import qualified Data.UUID.Types as UUID

52+import Data.Version (Version, parseVersion,

53+ showVersion)

54+import Data.Void (Void, absurd)

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

56+import qualified Network.HTTP.Types as H

57+import Numeric.Natural (Natural)

5358import Text.ParserCombinators.ReadP (readP_to_S)

5459import Text.Read (readMaybe)

60+import Web.Cookie (SetCookie, parseSetCookie,

61+ renderSetCookie)

62+

63+#if MIN_VERSION_time(1,9,1)

64+import Data.Time (nominalDiffTimeToSeconds,

65+ secondsToNominalDiffTime)

66+#endif

5567

5668#if USE_TEXT_SHOW

5769import TextShow (TextShow, showt)

5870#endif

5971

60−import qualified Data.UUID.Types as UUID

6172

62−import qualified Data.ByteString.Builder as BS

63−import Data.Data (Data)

64−import Data.Typeable (Typeable)

65−import qualified Network.HTTP.Types as H

66−

67−import qualified Data.Attoparsec.Text as Atto

68−import qualified Data.Attoparsec.Time as Atto

69−

70−import Web.Cookie (SetCookie, parseSetCookie,

71− renderSetCookie)

7273

7374

7475-- $setup

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

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

78+-- >>> import Data.Time

79+-- >>> import Data.Version

7780

7881-- | Convert value to HTTP API data.

7982--

@@ -432,10 +435,8 @@ instance ToHttpApiData Version where

432435 toUrlPiece = T.pack . showVersion

433436 toEncodedUrlPiece = unsafeToEncodedUrlPiece

434437

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

436438instance ToHttpApiData Void where toUrlPiece = absurd

437439instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

438−#endif

439440

440441instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece

441442instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece

@@ -494,36 +495,77 @@ instance ToHttpApiData UTCTime where

494495 toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"

495496 toEncodedUrlPiece = unsafeToEncodedUrlPiece

496497

498+-- The CPP in both this function and the function after it are to avoid

499+-- exporting @nominalDiffTimeToSeconds@ and @secondsToNominalDiffTime@,

500+-- since these names are already used by @Data.Time@ from the @time@ library

501+-- starting in version @1.9.1@.

502+nominalDiffTimeToSecs :: NominalDiffTime -> F.Pico

503+nominalDiffTimeToSecs =

504+#if !MIN_VERSION_time(1,9,1)

505+ realToFrac

506+#else

507+ nominalDiffTimeToSeconds

508+#endif

509+

510+secsToNominalDiffTime :: F.Pico -> NominalDiffTime

511+secsToNominalDiffTime =

512+#if !MIN_VERSION_time(1,9,1)

513+ realToFrac

514+#else

515+ secondsToNominalDiffTime

516+#endif

517+

497518instance ToHttpApiData NominalDiffTime where

498− toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)

519+ toUrlPiece = toUrlPiece . nominalDiffTimeToSecs

499520 toEncodedUrlPiece = unsafeToEncodedUrlPiece

500521

501522instance ToHttpApiData String where toUrlPiece = T.pack

502523instance ToHttpApiData Text where toUrlPiece = id

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

504525

505−instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll

506−instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny

526+instance ToHttpApiData All where

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

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

529+

530+instance ToHttpApiData Any where

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

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

507533

508534instance ToHttpApiData a => ToHttpApiData (Dual a) where

509− toUrlPiece = toUrlPiece . getDual

510− toEncodedUrlPiece = toEncodedUrlPiece . getDual

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

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

511537

512538instance ToHttpApiData a => ToHttpApiData (Sum a) where

513− toUrlPiece = toUrlPiece . getSum

514− toEncodedUrlPiece = toEncodedUrlPiece . getSum

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

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

515541

516542instance ToHttpApiData a => ToHttpApiData (Product a) where

517− toUrlPiece = toUrlPiece . getProduct

518− toEncodedUrlPiece = toEncodedUrlPiece . getProduct

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

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

519545

520546instance ToHttpApiData a => ToHttpApiData (First a) where

521− toUrlPiece = toUrlPiece . getFirst

522− toEncodedUrlPiece = toEncodedUrlPiece . getFirst

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

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

523549

524550instance ToHttpApiData a => ToHttpApiData (Last a) where

525− toUrlPiece = toUrlPiece . getLast

526− toEncodedUrlPiece = toEncodedUrlPiece . getLast

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

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

553+

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

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

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

557+

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

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

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

561+

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

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

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

565+

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

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

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

527569

528570-- |

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

@@ -555,6 +597,12 @@ instance ToHttpApiData SetCookie where

555597 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie

556598 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.

557599

600+instance ToHttpApiData a => ToHttpApiData (Tagged b a) where

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

602+ toHeader = coerce (toHeader :: a -> ByteString)

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

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

605+

558606-- |

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

560608-- Right ()

@@ -566,7 +614,7 @@ instance FromHttpApiData Char where

566614 parseUrlPiece s =

567615 case T.uncons s of

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

569− _ -> defaultParseError s

617+ _ -> defaultParseError s

570618

571619-- |

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

@@ -577,7 +625,6 @@ instance FromHttpApiData Version where

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

578626 _ -> defaultParseError s

579627

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

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

582629instance FromHttpApiData Void where

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

@@ -588,7 +635,6 @@ instance FromHttpApiData Natural where

588635 if n < 0

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

590637 else Right (fromInteger n)

591−#endif

592638

593639instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

594640instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

@@ -640,16 +686,21 @@ instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime

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

641687instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime

642688

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

689+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secsToNominalDiffTime . parseUrlPiece

690+

691+instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)

692+instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)

644693

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

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

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

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

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

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

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

647699

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

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

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

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

652−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece

700+instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

701+instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

702+instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

703+instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

653704

654705-- |

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

@@ -700,6 +751,11 @@ instance FromHttpApiData SetCookie where

700751 parseUrlPiece = parseHeader . encodeUtf8

701752 parseHeader = Right . parseSetCookie

702753

754+instance FromHttpApiData a => FromHttpApiData (Tagged b a) where

755+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

756+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

757+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)

758+

703759-------------------------------------------------------------------------------

704760-- Attoparsec helpers

705761-------------------------------------------------------------------------------

@@ -708,3 +764,5 @@ runAtto :: Atto.Parser a -> Text -> Either Text a

708764runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of

709765 Left err -> Left (T.pack err)

710766 Right x -> Right x

767+

768+

test/Web/Internal/HttpApiDataSpec.hs+31−57

@@ -1,35 +1,36 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE ScopedTypeVariables #-}

32module Web.Internal.HttpApiDataSpec (spec) where

5−import Control.Applicative

6−import qualified Data.Fixed as F

7−import Data.Int

8−import Data.Char

9−import Data.Word

10−import Data.Time

11−import qualified Data.Text as T

12−import qualified Data.Text.Encoding as TE

13−import qualified Data.Text.Lazy as L

14−import qualified Data.ByteString as BS

15−import Data.ByteString.Builder (toLazyByteString)

16−import Data.Version

17−import qualified Data.UUID.Types as UUID

18−import Web.Cookie (SetCookie, defaultSetCookie, setCookieName, setCookieValue)

194

20−import Data.Proxy

5+import Prelude ()

6+import Prelude.Compat

217

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

23−import Numeric.Natural

24−#endif

8+import qualified Data.ByteString as BS

9+import Data.ByteString.Builder (toLazyByteString)

10+import Data.Char

11+import qualified Data.Fixed as F

12+import Data.Int

13+import qualified Data.Text as T

14+import qualified Data.Text.Encoding as TE

15+import qualified Data.Text.Lazy as L

16+import Data.Time

17+import qualified Data.UUID.Types as UUID

18+import Data.Version

19+import Data.Word

20+import Web.Cookie (SetCookie, defaultSetCookie,

21+ setCookieName, setCookieValue)

2522

26−import Test.Hspec

27−import Test.Hspec.QuickCheck(prop)

28−import Test.QuickCheck

23+import Data.Proxy

2924

30−import Web.Internal.HttpApiData

25+import Numeric.Natural

3126

32−import Web.Internal.TestInstances

27+import Test.Hspec

28+import Test.Hspec.QuickCheck (prop)

29+import Test.QuickCheck

30+

31+import Web.Internal.HttpApiData

32+

33+import Web.Internal.TestInstances

3334

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

3536(f <=> g) x = counterexample

@@ -80,13 +81,13 @@ spec = do

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

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

8283 checkUrlPiece (Proxy :: Proxy Day) "Day"

83− checkUrlPiece' timeOfDayGen "TimeOfDay"

84− checkUrlPiece' localTimeGen "LocalTime"

85− checkUrlPiece' zonedTimeGen "ZonedTime"

86− checkUrlPiece' utcTimeGen "UTCTime"

87− checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"

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

85+ checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"

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

87+ checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"

88+ checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"

8889 checkUrlPiece (Proxy :: Proxy Version) "Version"

89− checkUrlPiece' uuidGen "UUID"

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

9091 checkUrlPiece' setCookieGen "Cookie"

9192

9293 checkUrlPiece (Proxy :: Proxy F.Uni) "Uni"

@@ -102,9 +103,7 @@ spec = do

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

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

104105

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

106106 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

107−#endif

108107

109108 it "bad integers are rejected" $ do

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

@@ -116,31 +115,6 @@ spec = do

116115 it "invalid utf8 is handled" $ do

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

118117

119−

120−uuidGen :: Gen UUID.UUID

121−uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

122−

123−-- TODO: this generators don't generate full range items

124−localTimeGen :: Gen LocalTime

125−localTimeGen = LocalTime <$> arbitrary <*> timeOfDayGen

126−

127−timeOfDayGen :: Gen TimeOfDay

128−timeOfDayGen = TimeOfDay

129− <$> choose (0, 23)

130− <*> choose (0, 59)

131− <*> fmap (\x -> 0.1 * fromInteger x) (choose (0, 600))

132−

133−zonedTimeGen :: Gen ZonedTime

134−zonedTimeGen = ZonedTime

135− <$> localTimeGen -- Note: not arbitrary!

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

137−

138−utcTimeGen :: Gen UTCTime

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

140−

141−nominalDiffTimeGen :: Gen NominalDiffTime

142−nominalDiffTimeGen = fromInteger <$> arbitrary

143−

144118setCookieGen :: Gen SetCookie

145119setCookieGen = do

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