Add instances for Natural (close #33)

Author: fizruk

src/Web/Internal/FormUrlEncoded.hs

@@ -43,6 +43,11 @@ import           Data.Text.Encoding.Error   (lenientDecode)
 import           Data.Time
 import           Data.Word
 
+#if MIN_VERSION_base(4,8,0)
+import Data.Void
+import Numeric.Natural
+#endif
+
 import           GHC.Exts                   (IsList (..))
 import           GHC.Generics
 import           URI.ByteString             (urlEncodeQuery, urlDecodeQuery)
@@ -104,6 +109,11 @@ instance ToFormKey a => ToFormKey (Dual a)    where toFormKey = toFormKey . getD
 instance ToFormKey a => ToFormKey (Sum a)     where toFormKey = toFormKey . getSum
 instance ToFormKey a => ToFormKey (Product a) where toFormKey = toFormKey . getProduct
 
+#if MIN_VERSION_base(4,8,0)
+instance ToFormKey Void     where toFormKey = toQueryParam
+instance ToFormKey Natural  where toFormKey = toQueryParam
+#endif
+
 -- | Typeclass for types that can be parsed from keys of a 'Form'. This is the reverse of 'ToFormKey'.
 class FromFormKey k where
   -- | Parse a key of a 'Form'.
@@ -146,6 +156,11 @@ instance FromFormKey a => FromFormKey (Dual a)    where parseFormKey = fmap Dual
 instance FromFormKey a => FromFormKey (Sum a)     where parseFormKey = fmap Sum . parseFormKey
 instance FromFormKey a => FromFormKey (Product a) where parseFormKey = fmap Product . parseFormKey
 
+#if MIN_VERSION_base(4,8,0)
+instance FromFormKey Void     where parseFormKey = parseQueryParam
+instance FromFormKey Natural  where parseFormKey = parseQueryParam
+#endif
+
 -- | The contents of a form, not yet URL-encoded.
 --
 -- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'.

src/Web/Internal/HttpApiData.hs

@@ -13,6 +13,7 @@ module Web.Internal.HttpApiData where
 import Control.Applicative
 import Data.Traversable (Traversable(traverse))
 #endif
+
 import Control.Arrow ((&&&), left)
 import Control.Monad ((<=<))
 
@@ -35,6 +36,7 @@ import Data.Version
 
 #if MIN_VERSION_base(4,8,0)
 import Data.Void
+import Numeric.Natural
 #endif
 
 import Text.Read (readMaybe)
@@ -390,8 +392,8 @@ instance ToHttpApiData Version where
   toUrlPiece = T.pack . showVersion
 
 #if MIN_VERSION_base(4,8,0)
-instance ToHttpApiData Void where
-  toUrlPiece = absurd
+instance ToHttpApiData Void    where toUrlPiece = absurd
+instance ToHttpApiData Natural where toUrlPiece = showt
 #endif
 
 instance ToHttpApiData Bool     where toUrlPiece = showTextData
@@ -491,6 +493,13 @@ instance FromHttpApiData Version where
 -- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
 instance FromHttpApiData Void where
   parseUrlPiece _ = Left "Void cannot be parsed!"
+
+instance FromHttpApiData Natural where
+  parseUrlPiece s = do
+    n <- runReader (signed decimal) s
+    if n < 0
+      then Left ("undeflow: " <> s <> " (should be a non-negative integer)")
+      else Right (fromInteger n)
 #endif
 
 instance FromHttpApiData Bool     where parseUrlPiece = parseBoundedUrlPiece

test/Web/Internal/HttpApiDataSpec.hs

@@ -1,4 +1,5 @@
-{-# Language ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Web.Internal.HttpApiDataSpec (spec) where
 
 import Data.Int
@@ -10,6 +11,11 @@ import qualified Data.ByteString as BS
 import Data.Version
 
 import Data.Proxy
+
+#if MIN_VERSION_base(4,8,0)
+import Numeric.Natural
+#endif
+
 import Test.Hspec
 import Test.Hspec.QuickCheck(prop)
 import Test.QuickCheck
@@ -18,7 +24,6 @@ import Web.Internal.HttpApiData
 
 import Web.Internal.TestInstances
 
-
 (<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
 (f <=> g) x = g (f x) == Right x
 
@@ -62,6 +67,10 @@ spec = do
     checkUrlPiece  (Proxy :: Proxy (Either Integer T.Text))   "Either Integer Text"
     checkUrlPieceI (Proxy :: Proxy (Either Version Day))      "Either Version Day"
 
+#if MIN_VERSION_base(4,8,0)
+    checkUrlPiece  (Proxy :: Proxy Natural)   "Natural"
+#endif
+
   it "bad integers are rejected" $ do
     parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)