Skip to content

Commit

Permalink
Add instances for Natural (close #33)
Browse files Browse the repository at this point in the history
  • Loading branch information
fizruk committed Aug 30, 2016
1 parent e9c728b commit d944721
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 4 deletions.
15 changes: 15 additions & 0 deletions src/Web/Internal/FormUrlEncoded.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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'.
Expand Down Expand Up @@ -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'.
Expand Down
13 changes: 11 additions & 2 deletions src/Web/Internal/HttpApiData.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ((<=<))

Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
13 changes: 11 additions & 2 deletions test/Web/Internal/HttpApiDataSpec.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# Language ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Web.Internal.HttpApiDataSpec (spec) where

import Data.Int
Expand All @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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)

Expand Down

0 comments on commit d944721

Please sign in to comment.