Merge pull request #16 from haskell-servant/jkarni/CommonTextTests
Fix Integer FromText instance.
This commit is contained in:
commit
a2f95f04c4
4 changed files with 72 additions and 13 deletions
|
@ -89,6 +89,7 @@ test-suite spec
|
|||
, bytestring
|
||||
, hspec == 2.*
|
||||
, QuickCheck
|
||||
, quickcheck-instances
|
||||
, parsec
|
||||
, servant
|
||||
, string-conversions
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
65
test/Servant/Common/TextSpec.hs
Normal file
65
test/Servant/Common/TextSpec.hs
Normal 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
|
Loading…
Reference in a new issue