f7876c3 · typeable/http-api-data

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

on master help sign in

Merge pull request #89 from fizruk/prepare-0.4

f7876c3Oleg Grenrus8 years ago

.travis.yml+6−7

compare with master

unifiedsplit

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

33matrix:

34 include:

35− - compiler: "ghc-8.6.1"

35+ - compiler: "ghc-8.6.2"

36 # 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]}}

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

38− - compiler: "ghc-8.4.3"

38+ - compiler: "ghc-8.4.4"

39 # 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]}}

41 - compiler: "ghc-8.2.2"

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

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

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

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

94script:

95 # test that source-distributions can be generated

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

96+ - cabal new-sdist all

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

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

98 - cd ${DISTDIR} || false

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

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

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

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

114

115 # haddock

116− - rm -rf ./dist-newstyle

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

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

118

117

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

118 # 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

10.3.10

80.3.10

2---

9---

http-api-data.cabal+19−10

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

1cabal-version: >= 1.10

2name: http-api-data

3−version: 0.3.10

3+version: 0.4

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

6category: Web

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

22 test/*.hs

23 CHANGELOG.md

24 README.md

25+

25tested-with:

26tested-with:

26 GHC==7.8.4,

27 GHC==7.8.4,

27 GHC==7.10.3,

28 GHC==7.10.3,

28 GHC==8.0.2,

29 GHC==8.0.2,

29 GHC==8.2.2,

30 GHC==8.2.2,

30− GHC==8.4.3,

31+ GHC==8.4.4,

31− GHC==8.6.1

32+ GHC==8.6.2

33custom-setup

34custom-setup

34 setup-depends:

35 setup-depends:

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

55 -- other-dependencies

56 -- other-dependencies

56 build-depends:

57 build-depends:

57 attoparsec >= 0.13.2.2 && < 0.14

58 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

59 , cookie >= 0.4.3 && < 0.4.5

61 , cookie >= 0.4.3 && < 0.4.5

60 , hashable >= 1.2.7.0 && < 1.3

62 , 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

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

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

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

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

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

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

69+ if !impl(ghc >= 7.10)

70+ build-depends:

71+ nats >= 1.1.2 && < 1.2,

72+ void >= 0.7.2 && < 0.8

73+

66 if !impl(ghc >= 8.0)

74 if !impl(ghc >= 8.0)

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

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

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

88 hs-source-dirs: test

96 hs-source-dirs: test

89 ghc-options: -Wall

97 ghc-options: -Wall

90 default-language: Haskell2010

98 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

92 -- inherited depndencies

100 -- inherited depndencies

93 build-depends:

101 build-depends:

94 base

102 base

103+ , base-compat

95 , bytestring

104 , bytestring

96− , unordered-containers

105+ , cookie

97 , http-api-data

106 , http-api-data

107+ , nats

98 , text

108 , text

99 , time

109 , time

100− , bytestring

110+ , unordered-containers

101 , uuid-types

111 , uuid-types

102− , cookie

103

112

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

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

105− , hspec >= 2.5.5 && <2.6

114+ , hspec >= 2.6.0 && <2.7

106 , QuickCheck >= 2.11.3 && <2.13

115 , QuickCheck >= 2.11.3 && <2.13

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

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

108

117

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

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

17#include "overlapping-compat.h"

18module Web.Internal.FormUrlEncoded where

20−#if __GLASGOW_HASKELL__ < 710

20+import Prelude ()

21−import Control.Applicative

21+import Prelude.Compat

22−import Data.Traversable

23−#endif

24−

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

23import Control.Arrow ((***))

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

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

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

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

29import qualified Data.ByteString.Lazy as BSL

26import qualified Data.ByteString.Lazy as BSL

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

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

28+import Data.Coerce (coerce)

31import qualified Data.Foldable as F

29import qualified Data.Foldable as F

32import Data.Hashable (Hashable)

30import Data.Hashable (Hashable)

33import Data.HashMap.Strict (HashMap)

31import Data.HashMap.Strict (HashMap)

34import qualified Data.HashMap.Strict as HashMap

32import qualified Data.HashMap.Strict as HashMap

35−import Data.Int

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

36import Data.IntMap (IntMap)

34import Data.IntMap (IntMap)

37import qualified Data.IntMap as IntMap

35import qualified Data.IntMap as IntMap

38import Data.List (intersperse, sortBy)

36import Data.List (intersperse, sortBy)

39import Data.Map (Map)

37import Data.Map (Map)

40import qualified Data.Map as Map

38import qualified Data.Map as Map

41−import Data.Monoid

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

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

42import Data.Ord (comparing)

41import Data.Ord (comparing)

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

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

43import qualified Data.Semigroup as Semi

44import qualified Data.Semigroup as Semi

44−

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

45import Data.Text (Text)

46import Data.Text (Text)

46import qualified Data.Text as Text

47import qualified Data.Text as Text

47−import Data.Text.Encoding as Text

48+import qualified Data.Text.Encoding as Text

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

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

49import qualified Data.Text.Lazy as Lazy

50import qualified Data.Text.Lazy as Lazy

50−

51−import Data.Proxy

52−import Data.Time

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

52+ UTCTime, ZonedTime)

53+import Data.Void (Void)

53−import Data.Word

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

54−

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

56−import Data.Void

57−import Numeric.Natural

58−#endif

59−

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

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

61import GHC.Generics

56import GHC.Generics

62import GHC.TypeLits

57import GHC.TypeLits

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

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

64−

59+import Numeric.Natural (Natural)

65import Web.Internal.HttpApiData

60import Web.Internal.HttpApiData

67-- $setup

62-- $setup

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

124instance ToFormKey All where toFormKey = toQueryParam

119instance ToFormKey All where toFormKey = toQueryParam

125instance ToFormKey Any where toFormKey = toQueryParam

120instance ToFormKey Any where toFormKey = toQueryParam

126

121

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

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

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

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

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

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)

130

132

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

132instance ToFormKey Void where toFormKey = toQueryParam

133instance ToFormKey Void where toFormKey = toQueryParam

133instance ToFormKey Natural where toFormKey = toQueryParam

134instance ToFormKey Natural where toFormKey = toQueryParam

134−#endif

135

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

137class FromFormKey k where

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

171instance FromFormKey All where parseFormKey = parseQueryParam

172instance FromFormKey Any where parseFormKey = parseQueryParam

173

174−instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual . 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 = fmap Sum . parseFormKey

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)

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

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)

177

184

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

179instance FromFormKey Void where parseFormKey = parseQueryParam

185instance FromFormKey Void where parseFormKey = parseQueryParam

180instance FromFormKey Natural where parseFormKey = parseQueryParam

186instance FromFormKey Natural where parseFormKey = parseQueryParam

181−#endif

182

187

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

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

184--

189--

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

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

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

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

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

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

188

193

189instance Show Form where

194instance Show Form where

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

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

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

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

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

14module Web.Internal.HttpApiData where

16−#if __GLASGOW_HASKELL__ < 710

16+import Prelude ()

17−import Control.Applicative

17+import Prelude.Compat

18−import Data.Foldable (Foldable)

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

20−#endif

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

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

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

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

24−

21+import qualified Data.Attoparsec.Text as Atto

22+import qualified Data.Attoparsec.Time as Atto

25import Data.ByteString (ByteString)

23import Data.ByteString (ByteString)

26import qualified Data.ByteString as BS

24import qualified Data.ByteString as BS

25+import qualified Data.ByteString.Builder as BS

27import qualified Data.ByteString.Lazy as LBS

26import qualified Data.ByteString.Lazy as LBS

28−import Data.Monoid

27+import Data.Coerce (coerce)

29−

28+import Data.Data (Data)

30import qualified Data.Fixed as F

29import qualified Data.Fixed as F

31−import Data.Int

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

32−import Data.Word

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

33−

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

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

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

35+import qualified Data.Semigroup as Semi

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

34import Data.Text (Text)

37import Data.Text (Text)

35import qualified Data.Text as T

38import qualified Data.Text as T

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

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

40+ encodeUtf8)

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

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

38import qualified Data.Text.Lazy as L

42import qualified Data.Text.Lazy as L

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

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

40 signed)

44 signed)

41−

42−import Data.Time

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

43−#if __GLASGOW_HASKELL__ < 710

46+ NominalDiffTime, TimeOfDay,

47+ UTCTime, ZonedTime, formatTime)

44−import Data.Time.Locale.Compat

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

45−#endif

49+ iso8601DateFormat)

46−import Data.Version

50+import Data.Typeable (Typeable)

47−

51+import qualified Data.UUID.Types as UUID

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

52+import Data.Version (Version, parseVersion,

53+ showVersion)

49−import Data.Void

54+import Data.Void (Void, absurd)

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

56+import qualified Network.HTTP.Types as H

50−import Numeric.Natural

57+import Numeric.Natural (Natural)

51−#endif

52−

53import Text.ParserCombinators.ReadP (readP_to_S)

58import Text.ParserCombinators.ReadP (readP_to_S)

54import Text.Read (readMaybe)

59import 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

56#if USE_TEXT_SHOW

68#if USE_TEXT_SHOW

57import TextShow (TextShow, showt)

69import TextShow (TextShow, showt)

58#endif

70#endif

60−import qualified Data.UUID.Types as UUID

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)

74-- $setup

75-- $setup

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

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

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

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

78+-- >>> import Data.Time

79+-- >>> import Data.Version

78-- | Convert value to HTTP API data.

81-- | Convert value to HTTP API data.

79--

82--

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

432 toUrlPiece = T.pack . showVersion

435 toUrlPiece = T.pack . showVersion

433 toEncodedUrlPiece = unsafeToEncodedUrlPiece

436 toEncodedUrlPiece = unsafeToEncodedUrlPiece

434

437

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

436instance ToHttpApiData Void where toUrlPiece = absurd

438instance ToHttpApiData Void where toUrlPiece = absurd

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

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

438−#endif

439

440

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

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

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

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

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

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

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

495 toEncodedUrlPiece = unsafeToEncodedUrlPiece

496 toEncodedUrlPiece = unsafeToEncodedUrlPiece

496

497

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+

497instance ToHttpApiData NominalDiffTime where

518instance ToHttpApiData NominalDiffTime where

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

519+ toUrlPiece = toUrlPiece . nominalDiffTimeToSecs

499 toEncodedUrlPiece = unsafeToEncodedUrlPiece

520 toEncodedUrlPiece = unsafeToEncodedUrlPiece

500

521

501instance ToHttpApiData String where toUrlPiece = T.pack

522instance ToHttpApiData String where toUrlPiece = T.pack

502instance ToHttpApiData Text where toUrlPiece = id

523instance ToHttpApiData Text where toUrlPiece = id

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

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

504

525

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

526+instance ToHttpApiData All where

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

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

529+

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

530+instance ToHttpApiData Any where

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

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

507

533

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

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

509− toUrlPiece = toUrlPiece . getDual

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

510− toEncodedUrlPiece = toEncodedUrlPiece . getDual

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

511

537

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

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

513− toUrlPiece = toUrlPiece . getSum

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

514− toEncodedUrlPiece = toEncodedUrlPiece . getSum

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

515

541

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

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

517− toUrlPiece = toUrlPiece . getProduct

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

518− toEncodedUrlPiece = toEncodedUrlPiece . getProduct

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

519

545

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

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

521− toUrlPiece = toUrlPiece . getFirst

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

522− toEncodedUrlPiece = toEncodedUrlPiece . getFirst

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

523

549

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

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

525− toUrlPiece = toUrlPiece . 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)

526− toEncodedUrlPiece = toEncodedUrlPiece . getLast

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)

527

569

528-- |

570-- |

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

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

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

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

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

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

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

557

599

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+

558-- |

606-- |

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

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

560-- Right ()

608-- Right ()

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

566 parseUrlPiece s =

614 parseUrlPiece s =

567 case T.uncons s of

615 case T.uncons s of

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

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

569− _ -> defaultParseError s

617+ _ -> defaultParseError s

570

618

571-- |

619-- |

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

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

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

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

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

578 _ -> defaultParseError s

626 _ -> defaultParseError s

579

627

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

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

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

582instance FromHttpApiData Void where

629instance FromHttpApiData Void where

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

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

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

588 if n < 0

635 if n < 0

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

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

590 else Right (fromInteger n)

637 else Right (fromInteger n)

591−#endif

592

638

593instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

639instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

594instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

640instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece

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

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

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

641instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime

687instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime

642

688

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)

644

693

645−instance FromHttpApiData All where parseUrlPiece = fmap All . 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)

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

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

647

699

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

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

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

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

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

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

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

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

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

653

704

654-- |

705-- |

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

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

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

700 parseUrlPiece = parseHeader . encodeUtf8

751 parseUrlPiece = parseHeader . encodeUtf8

701 parseHeader = Right . parseSetCookie

752 parseHeader = Right . parseSetCookie

702

753

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+

703-------------------------------------------------------------------------------

759-------------------------------------------------------------------------------

704-- Attoparsec helpers

760-- Attoparsec helpers

705-------------------------------------------------------------------------------

761-------------------------------------------------------------------------------

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

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

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

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

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

710 Right x -> Right x

766 Right x -> Right x

767+

768+

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

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

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE ScopedTypeVariables #-}

1{-# LANGUAGE ScopedTypeVariables #-}

3module Web.Internal.HttpApiDataSpec (spec) where

2module 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)

20−import Data.Proxy

5+import Prelude ()

6+import Prelude.Compat

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

8+import qualified Data.ByteString as BS

23−import Numeric.Natural

9+import Data.ByteString.Builder (toLazyByteString)

24−#endif

10+import Data.Char

11+import qualified Data.Fixed as F

12+import Data.Int

13+import qualified Data.Text as T

14+import qualified Data.Text.Encoding as TE

15+import qualified Data.Text.Lazy as L

16+import Data.Time

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)

26−import Test.Hspec

23+import Data.Proxy

27−import Test.Hspec.QuickCheck(prop)

28−import Test.QuickCheck

30−import Web.Internal.HttpApiData

25+import Numeric.Natural

27+import Test.Hspec

28+import Test.Hspec.QuickCheck (prop)

29+import Test.QuickCheck

30+

31+import Web.Internal.HttpApiData

32+

32−import Web.Internal.TestInstances

33+import Web.Internal.TestInstances

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

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

35(f <=> g) x = counterexample

36(f <=> g) x = counterexample

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

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

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

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

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

82 checkUrlPiece (Proxy :: Proxy Day) "Day"

83 checkUrlPiece (Proxy :: Proxy Day) "Day"

83− checkUrlPiece' timeOfDayGen "TimeOfDay"

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

84− checkUrlPiece' localTimeGen "LocalTime"

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

85− checkUrlPiece' zonedTimeGen "ZonedTime"

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

86− checkUrlPiece' utcTimeGen "UTCTime"

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

87− checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"

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

88 checkUrlPiece (Proxy :: Proxy Version) "Version"

89 checkUrlPiece (Proxy :: Proxy Version) "Version"

89− checkUrlPiece' uuidGen "UUID"

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

90 checkUrlPiece' setCookieGen "Cookie"

91 checkUrlPiece' setCookieGen "Cookie"

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

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

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

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

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

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

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

104

105

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

106 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

107−#endif

108

107

109 it "bad integers are rejected" $ do

108 it "bad integers are rejected" $ do

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

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

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

116 it "invalid utf8 is handled" $ do

115 it "invalid utf8 is handled" $ do

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

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

118

117

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−

144setCookieGen :: Gen SetCookie

118setCookieGen :: Gen SetCookie

145setCookieGen = do

119setCookieGen = do

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

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