git.iko.soy/typeable/http-api-data
on master help sign in
Add instances for Natural (close #33)
commitd944721ac94929a7ed9e66f25e23221799c08d83 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateWed 31 Aug 2016, 00:41 (10 years ago) parente9c728b
3 files changed+37−4
compare with master
unifiedsplit
src/Web/Internal/FormUrlEncoded.hs+15 src/Web/Internal/HttpApiData.hs+11−2 test/Web/Internal/HttpApiDataSpec.hs+11−2
src/Web/Internal/FormUrlEncoded.hs+15
@@ -43,6 +43,11 @@ import Data.Text.Encoding.Error (lenientDecode)
4343import Data.Time
4444import Data.Word
4545
46+#if MIN_VERSION_base(4,8,0)
47+import Data.Void
48+import Numeric.Natural
49+#endif
50+
4651import GHC.Exts (IsList (..))
4752import GHC.Generics
4853import URI.ByteString (urlEncodeQuery, urlDecodeQuery)
@@ -104,6 +109,11 @@ instance ToFormKey a => ToFormKey (Dual a) where toFormKey = toFormKey . getD
104109instance ToFormKey a => ToFormKey (Sum a) where toFormKey = toFormKey . getSum
105110instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
106111
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+
107117-- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
108118class FromFormKey k where
109119 -- | Parse a key of a 'Form'.
@@ -146,6 +156,11 @@ instance FromFormKey a => FromFormKey (Dual a) where parseFormKey = fmap Dual
146156instance FromFormKey a => FromFormKey (Sum a) where parseFormKey = fmap Sum . parseFormKey
147157instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
148158
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+
149164-- | The contents of a form, not yet URL-encoded.
150165--
151166-- '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
1313import Control.Applicative
1414import Data.Traversable (Traversable(traverse))
1515#endif
16+
1617import Control.Arrow ((&&&), left)
1718import Control.Monad ((<=<))
1819
@@ -35,6 +36,7 @@ import Data.Version
3536
3637#if MIN_VERSION_base(4,8,0)
3738import Data.Void
39+import Numeric.Natural
3840#endif
3941
4042import Text.Read (readMaybe)
@@ -390,8 +392,8 @@ instance ToHttpApiData Version where
390392 toUrlPiece = T.pack . showVersion
391393
392394#if MIN_VERSION_base(4,8,0)
393−instance ToHttpApiData Void where
394− toUrlPiece = absurd
395+instance ToHttpApiData Void where toUrlPiece = absurd
396+instance ToHttpApiData Natural where toUrlPiece = showt
395397#endif
396398
397399instance ToHttpApiData Bool where toUrlPiece = showTextData
@@ -491,6 +493,13 @@ instance FromHttpApiData Version where
491493-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
492494instance FromHttpApiData Void where
493495 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)
494503#endif
495504
496505instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
test/Web/Internal/HttpApiDataSpec.hs+11−2
@@ -1,4 +1,5 @@
1−{-# Language ScopedTypeVariables #-}
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23module Web.Internal.HttpApiDataSpec (spec) where
34
45import Data.Int
@@ -10,6 +11,11 @@ import qualified Data.ByteString as BS
1011import Data.Version
1112
1213import Data.Proxy
14+
15+#if MIN_VERSION_base(4,8,0)
16+import Numeric.Natural
17+#endif
18+
1319import Test.Hspec
1420import Test.Hspec.QuickCheck(prop)
1521import Test.QuickCheck
@@ -18,7 +24,6 @@ import Web.Internal.HttpApiData
1824
1925import Web.Internal.TestInstances
2026
21−
2227(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
2328(f <=> g) x = g (f x) == Right x
2429
@@ -62,6 +67,10 @@ spec = do
6267 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
6368 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
6469
70+#if MIN_VERSION_base(4,8,0)
71+ checkUrlPiece (Proxy :: Proxy Natural) "Natural"
72+#endif
73+
6574 it "bad integers are rejected" $ do
6675 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
6776