git.iko.soy/typeable/http-api-data
on be2bfcd help sign in
typeable/http-api-data/test/Spec.hs
128 lines 4.8 kB history raw
1{-# Language ScopedTypeVariables #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3module Main where
5import Control.Applicative
7import Data.Int
8import Data.Char
9import Data.Word
10import Data.Time
11import qualified Data.Text as T
12import qualified Data.Text.Lazy as L
13import Data.Version
15import Test.Hspec
16import Test.Hspec.QuickCheck(prop)
17import Test.QuickCheck
19import Web.HttpApiData
21instance Arbitrary T.Text where
22 arbitrary = T.pack <$> arbitrary
24instance Arbitrary L.Text where
25 arbitrary = L.pack <$> arbitrary
27instance Arbitrary Day where
28 arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
30instance Arbitrary LocalTime where
31 arbitrary = LocalTime
32 <$> arbitrary
33 <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
35instance Eq ZonedTime where
36 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
38instance Arbitrary ZonedTime where
39 arbitrary = ZonedTime
40 <$> arbitrary
41 <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
43instance Arbitrary UTCTime where
44 arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
46instance Arbitrary NominalDiffTime where
47 arbitrary = fromInteger <$> arbitrary
49instance Arbitrary Version where
50 arbitrary = (version . map abs) <$> nonempty
51 where
52 version branch = Version branch []
53 nonempty = liftA2 (:) arbitrary arbitrary
55main :: IO ()
56main = hspec spec
58(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
59(f <=> g) x = g (f x) == Right x
61data Proxy a = Proxy
63checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
64checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
66data RandomCase a = RandomCase [Bool] a
68instance ToHttpApiData a => Show (RandomCase a) where
69 show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")"
71instance Eq a => Eq (RandomCase a) where
72 RandomCase _ x == RandomCase _ y = x == y
74instance Arbitrary a => Arbitrary (RandomCase a) where
75 arbitrary = liftA2 RandomCase nonempty arbitrary
76 where
77 nonempty = liftA2 (:) arbitrary arbitrary
79instance ToHttpApiData a => ToHttpApiData (RandomCase a) where
80 toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x)))
82instance FromHttpApiData a => FromHttpApiData (RandomCase a) where
83 parseUrlPiece s = RandomCase [] <$> parseUrlPiece s
85-- | Check case insensitivity for @parseUrlPiece@.
86checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
87checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
89spec :: Spec
90spec = do
91 describe "toUrlPiece <=> parseUrlPiece" $ do
92 checkUrlPiece (Proxy :: Proxy ()) "()"
93 checkUrlPiece (Proxy :: Proxy Char) "Char"
94 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
95 checkUrlPieceI (Proxy :: Proxy Ordering) "Ordering"
96 checkUrlPiece (Proxy :: Proxy Int) "Int"
97 checkUrlPiece (Proxy :: Proxy Int8) "Int8"
98 checkUrlPiece (Proxy :: Proxy Int16) "Int16"
99 checkUrlPiece (Proxy :: Proxy Int32) "Int32"
100 checkUrlPiece (Proxy :: Proxy Int64) "Int64"
101 checkUrlPiece (Proxy :: Proxy Integer) "Integer"
102 checkUrlPiece (Proxy :: Proxy Word) "Word"
103 checkUrlPiece (Proxy :: Proxy Word8) "Word8"
104 checkUrlPiece (Proxy :: Proxy Word16) "Word16"
105 checkUrlPiece (Proxy :: Proxy Word32) "Word32"
106 checkUrlPiece (Proxy :: Proxy Word64) "Word64"
107 checkUrlPiece (Proxy :: Proxy String) "String"
108 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
109 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
110 checkUrlPiece (Proxy :: Proxy Day) "Day"
111 checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"
112 checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"
113 checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
114 checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
115 checkUrlPiece (Proxy :: Proxy Version) "Version"
117 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
118 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
119 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
120 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
122 it "bad integers are rejected" $ do
123 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
125 it "bounds checking works" $ do
126 parseUrlPieceMaybe (T.pack "256") `shouldBe` (Nothing :: Maybe Int8)
127 parseUrlPieceMaybe (T.pack "-10") `shouldBe` (Nothing :: Maybe Word)