Fix Integer FromText instance.

And add FromText/ToText tests.
This commit is contained in:
Julian K. Arni 2015-02-20 16:54:45 +01:00
parent 5f1e8c3607
commit 5be2430b11
4 changed files with 72 additions and 13 deletions

View File

@ -89,6 +89,7 @@ test-suite spec
, bytestring
, hspec == 2.*
, QuickCheck
, quickcheck-instances
, parsec
, servant
, string-conversions

View File

@ -13,10 +13,14 @@ import Data.Text.Read ( rational, signed, decimal, Reader )
import Data.Word ( Word, Word8, Word16, Word32, Word64 )
-- | For getting values from url captures and query string parameters
-- Instances should obey:
-- > fromText (toText a) == Just a
class FromText a where
fromText :: Text -> Maybe a
-- | For putting values in paths and query string parameters
-- Instances should obey:
-- > fromText (toText a) == Just a
class ToText a where
toText :: a -> Text
@ -109,7 +113,7 @@ instance ToText Word64 where
toText = cs . show
instance FromText Integer where
fromText = runReader decimal
fromText = runReader (signed decimal)
instance ToText Integer where
toText = cs . show

View File

@ -21,6 +21,7 @@ import qualified Data.Text.Lazy as TextL
import GHC.Generics
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import Servant.API.ContentTypes
@ -145,12 +146,6 @@ instance ToJSON SomeData
instance Arbitrary SomeData where
arbitrary = SomeData <$> arbitrary <*> arbitrary
instance Arbitrary TextL.Text where
arbitrary = TextL.pack <$> arbitrary
instance Arbitrary TextS.Text where
arbitrary = TextS.pack <$> arbitrary
instance Arbitrary ZeroToOne where
arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
@ -169,12 +164,6 @@ instance ToJSON ByteString where
instance IsString AcceptHeader where
fromString = AcceptHeader . fromString
instance Arbitrary BSL.ByteString where
arbitrary = cs <$> (arbitrary :: Gen String)
instance Arbitrary ByteString where
arbitrary = cs <$> (arbitrary :: Gen String)
addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)

View File

@ -0,0 +1,65 @@
module Servant.Common.TextSpec where
import Servant.Common.Text
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Text ( Text )
import Data.Word ( Word, Word8, Word16, Word32, Word64 )
spec :: Spec
spec = describe "Servant.Common.Text" $ do
context "FromText and ToText laws" $ do
it "holds for Text" $
property $ \x -> textLaw (x :: Text)
it "holds for String" $
property $ \x -> textLaw (x :: String)
it "holds for Bool" $
property $ \x -> textLaw (x :: Bool)
it "holds for Int" $
property $ \x -> textLaw (x :: Int)
it "holds for Int8" $
property $ \x -> textLaw (x :: Int8)
it "holds for Int16" $
property $ \x -> textLaw (x :: Int16)
it "holds for Int32" $
property $ \x -> textLaw (x :: Int32)
it "holds for Int64" $
property $ \x -> textLaw (x :: Int64)
it "holds for Word" $
property $ \x -> textLaw (x :: Word)
it "holds for Word8" $
property $ \x -> textLaw (x :: Word8)
it "holds for Word16" $
property $ \x -> textLaw (x :: Word16)
it "holds for Word32" $
property $ \x -> textLaw (x :: Word32)
it "holds for Word64" $
property $ \x -> textLaw (x :: Word64)
it "holds for Integer" $
property $ \x -> textLaw (x :: Integer)
it "holds for Double" $
property $ \x -> textLaw (x :: Double)
it "holds for Float" $
property $ \x -> textLaw (x :: Float)
textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
textLaw a = fromText (toText a) == Just a