d944721 · typeable/http-api-data

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

on master help sign in

Add instances for Natural (close #33)

d944721Nickolay Kudasov10 years ago

src/Web/Internal/FormUrlEncoded.hs+15

compare with master

unifiedsplit

@@ -43,6 +43,11 @@ import Data.Text.Encoding.Error (lenientDecode)

43import Data.Time

44import Data.Word

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

47+import Data.Void

48+import Numeric.Natural

49+#endif

50+

46import GHC.Exts (IsList (..))

51import GHC.Exts (IsList (..))

47import GHC.Generics

52import GHC.Generics

48import URI.ByteString (urlEncodeQuery, urlDecodeQuery)

53import URI.ByteString (urlEncodeQuery, urlDecodeQuery)

@@ -104,6 +109,11 @@ instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getD

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

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

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

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

106

111

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

113+instance ToFormKey Void where toFormKey = toQueryParam

114+instance ToFormKey Natural where toFormKey = toQueryParam

115+#endif

116+

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

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

108class FromFormKey k where

118class FromFormKey k where

109 -- | Parse a key of a 'Form'.

119 -- | Parse a key of a 'Form'.

@@ -146,6 +156,11 @@ instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual

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

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

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

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

148

158

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

160+instance FromFormKey Void where parseFormKey = parseQueryParam

161+instance FromFormKey Natural where parseFormKey = parseQueryParam

162+#endif

163+

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

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

150--

165--

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

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

src/Web/Internal/HttpApiData.hs+11−2

@@ -13,6 +13,7 @@ module Web.Internal.HttpApiData where

13import Control.Applicative

14import Data.Traversable (Traversable(traverse))

15#endif

16+

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

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

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

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

@@ -35,6 +36,7 @@ import Data.Version

36#if MIN_VERSION_base(4,8,0)

37#if MIN_VERSION_base(4,8,0)

37import Data.Void

38import Data.Void

39+import Numeric.Natural

38#endif

40#endif

40import Text.Read (readMaybe)

42import Text.Read (readMaybe)

@@ -390,8 +392,8 @@ instance ToHttpApiData Version where

390 toUrlPiece = T.pack . showVersion

392 toUrlPiece = T.pack . showVersion

391

393

392#if MIN_VERSION_base(4,8,0)

394#if MIN_VERSION_base(4,8,0)

393−instance ToHttpApiData Void where

395+instance ToHttpApiData Void where toUrlPiece = absurd

394− toUrlPiece = absurd

396+instance ToHttpApiData Natural where toUrlPiece = showt

395#endif

397#endif

396

398

397instance ToHttpApiData Bool where toUrlPiece = showTextData

399instance ToHttpApiData Bool where toUrlPiece = showTextData

@@ -491,6 +493,13 @@ instance FromHttpApiData Version where

491-- | 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.

492instance FromHttpApiData Void where

494instance FromHttpApiData Void where

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

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

496+

497+instance FromHttpApiData Natural where

498+ parseUrlPiece s = do

499+ n <- runReader (signed decimal) s

500+ if n < 0

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

502+ else Right (fromInteger n)

494#endif

503#endif

495

504

496instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

505instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece

test/Web/Internal/HttpApiDataSpec.hs+11−2

@@ -1,4 +1,5 @@

1+{-# LANGUAGE CPP #-}

1−{-# Language ScopedTypeVariables #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

2module Web.Internal.HttpApiDataSpec (spec) where

3module Web.Internal.HttpApiDataSpec (spec) where

4import Data.Int

5import Data.Int

@@ -10,6 +11,11 @@ import qualified Data.ByteString as BS

10import Data.Version

11import Data.Version

12import Data.Proxy

13import Data.Proxy

14+

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

16+import Numeric.Natural

17+#endif

18+

13import Test.Hspec

19import Test.Hspec

14import Test.Hspec.QuickCheck(prop)

20import Test.Hspec.QuickCheck(prop)

15import Test.QuickCheck

21import Test.QuickCheck

@@ -18,7 +24,6 @@ import Web.Internal.HttpApiData

19import Web.Internal.TestInstances

25import Web.Internal.TestInstances

21−

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

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

23(f <=> g) x = g (f x) == Right x

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

@@ -62,6 +67,10 @@ spec = do

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

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

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

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

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

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

72+#endif

73+

65 it "bad integers are rejected" $ do

74 it "bad integers are rejected" $ do

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

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