git.iko.soy/typeable/servant
on master help sign in
Merge pull request #16 from haskell-servant/jkarni/CommonTextTests

Fix Integer FromText instance.

commita2f95f04c4838d77c8f6e04c1749fd0522cce15a authorJulian Arni <jkarni@gmail.com> dateFri 20 Feb 2015, 17:27 (12 years ago) parent5f1e8c35be2430
4 files changed+72−13
compare with master
unifiedsplit
servant.cabal+1 src/Servant/Common/Text.hs+5−1 test/Servant/API/ContentTypesSpec.hs+1−12 test/Servant/Common/TextSpec.hs+65
servant.cabal+1
@@ -89,6 +89,7 @@ test-suite spec
8989 , bytestring
9090 , hspec == 2.*
9191 , QuickCheck
92+ , quickcheck-instances
9293 , parsec
9394 , servant
9495 , string-conversions
src/Servant/Common/Text.hs+5−1
@@ -13,10 +13,14 @@ import Data.Text.Read ( rational, signed, decimal, Reader )
1313import Data.Word ( Word, Word8, Word16, Word32, Word64 )
1414
1515-- | For getting values from url captures and query string parameters
16+-- Instances should obey:
17+-- > fromText (toText a) == Just a
1618class FromText a where
1719 fromText :: Text -> Maybe a
1820
1921-- | For putting values in paths and query string parameters
22+-- Instances should obey:
23+-- > fromText (toText a) == Just a
2024class ToText a where
2125 toText :: a -> Text
2226
@@ -109,7 +113,7 @@ instance ToText Word64 where
109113 toText = cs . show
110114
111115instance FromText Integer where
112− fromText = runReader decimal
116+ fromText = runReader (signed decimal)
113117
114118instance ToText Integer where
115119 toText = cs . show
test/Servant/API/ContentTypesSpec.hs+1−12
@@ -21,6 +21,7 @@ import qualified Data.Text.Lazy as TextL
2121import GHC.Generics
2222import Test.Hspec
2323import Test.QuickCheck
24+import Test.QuickCheck.Instances ()
2425
2526import Servant.API.ContentTypes
2627
@@ -145,12 +146,6 @@ instance ToJSON SomeData
145146instance Arbitrary SomeData where
146147 arbitrary = SomeData <$> arbitrary <*> arbitrary
147148
148−instance Arbitrary TextL.Text where
149− arbitrary = TextL.pack <$> arbitrary
150−
151−instance Arbitrary TextS.Text where
152− arbitrary = TextS.pack <$> arbitrary
153−
154149instance Arbitrary ZeroToOne where
155150 arbitrary = ZeroToOne <$> elements [ x / 10 | x <- [1..10]]
156151
@@ -169,12 +164,6 @@ instance ToJSON ByteString where
169164instance IsString AcceptHeader where
170165 fromString = AcceptHeader . fromString
171166
172−instance Arbitrary BSL.ByteString where
173− arbitrary = cs <$> (arbitrary :: Gen String)
174−
175−instance Arbitrary ByteString where
176− arbitrary = cs <$> (arbitrary :: Gen String)
177−
178167addToAccept :: Accept a => Proxy a -> ZeroToOne -> AcceptHeader -> AcceptHeader
179168addToAccept p (ZeroToOne f) (AcceptHeader h) = AcceptHeader (cont h)
180169 where new = cs (show $ contentType p) `append` "; q=" `append` pack (show f)
test/Servant/Common/TextSpec.hsnew file+65
@@ -0,0 +1,65 @@
1+module Servant.Common.TextSpec where
2+
3+import Servant.Common.Text
4+import Test.Hspec
5+import Test.QuickCheck
6+import Test.QuickCheck.Instances ()
7+import Data.Int ( Int8, Int16, Int32, Int64 )
8+import Data.Text ( Text )
9+import Data.Word ( Word, Word8, Word16, Word32, Word64 )
10+
11+spec :: Spec
12+spec = describe "Servant.Common.Text" $ do
13+
14+ context "FromText and ToText laws" $ do
15+
16+ it "holds for Text" $
17+ property $ \x -> textLaw (x :: Text)
18+
19+ it "holds for String" $
20+ property $ \x -> textLaw (x :: String)
21+
22+ it "holds for Bool" $
23+ property $ \x -> textLaw (x :: Bool)
24+
25+ it "holds for Int" $
26+ property $ \x -> textLaw (x :: Int)
27+
28+ it "holds for Int8" $
29+ property $ \x -> textLaw (x :: Int8)
30+
31+ it "holds for Int16" $
32+ property $ \x -> textLaw (x :: Int16)
33+
34+ it "holds for Int32" $
35+ property $ \x -> textLaw (x :: Int32)
36+
37+ it "holds for Int64" $
38+ property $ \x -> textLaw (x :: Int64)
39+
40+ it "holds for Word" $
41+ property $ \x -> textLaw (x :: Word)
42+
43+ it "holds for Word8" $
44+ property $ \x -> textLaw (x :: Word8)
45+
46+ it "holds for Word16" $
47+ property $ \x -> textLaw (x :: Word16)
48+
49+ it "holds for Word32" $
50+ property $ \x -> textLaw (x :: Word32)
51+
52+ it "holds for Word64" $
53+ property $ \x -> textLaw (x :: Word64)
54+
55+ it "holds for Integer" $
56+ property $ \x -> textLaw (x :: Integer)
57+
58+ it "holds for Double" $
59+ property $ \x -> textLaw (x :: Double)
60+
61+ it "holds for Float" $
62+ property $ \x -> textLaw (x :: Float)
63+
64+textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
65+textLaw a = fromText (toText a) == Just a