git.iko.soy/typeable/http-api-data
on v0.1.1.1 help sign in
typeable/http-api-data/test/Spec.hs
106 lines 4.0 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
20import Web.HttpApiData.Internal
22instance Arbitrary T.Text where
23 arbitrary = T.pack <$> arbitrary
25instance Arbitrary L.Text where
26 arbitrary = L.pack <$> arbitrary
28instance Arbitrary Day where
29 arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
31instance Arbitrary Version where
32 arbitrary = (version . map abs) <$> nonempty
33 where
34 version branch = Version branch []
35 nonempty = liftA2 (:) arbitrary arbitrary
37main :: IO ()
38main = hspec spec
40(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
41(f <=> g) x = g (f x) == Right x
43data Proxy a = Proxy
45checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
46checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
48data RandomCase a = RandomCase [Bool] a
50instance ToHttpApiData a => Show (RandomCase a) where
51 show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")"
53instance Eq a => Eq (RandomCase a) where
54 RandomCase _ x == RandomCase _ y = x == y
56instance Arbitrary a => Arbitrary (RandomCase a) where
57 arbitrary = liftA2 RandomCase nonempty arbitrary
58 where
59 nonempty = liftA2 (:) arbitrary arbitrary
61instance ToHttpApiData a => ToHttpApiData (RandomCase a) where
62 toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x)))
64instance FromHttpApiData a => FromHttpApiData (RandomCase a) where
65 parseUrlPiece s = RandomCase [] <$> parseUrlPiece s
67-- | Check case insensitivity for @parseUrlPiece@.
68checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
69checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
71spec :: Spec
72spec = do
73 describe "toUrlPiece <=> parseUrlPiece" $ do
74 checkUrlPiece (Proxy :: Proxy ()) "()"
75 checkUrlPiece (Proxy :: Proxy Char) "Char"
76 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
77 checkUrlPieceI (Proxy :: Proxy Ordering) "Ordering"
78 checkUrlPiece (Proxy :: Proxy Int) "Int"
79 checkUrlPiece (Proxy :: Proxy Int8) "Int8"
80 checkUrlPiece (Proxy :: Proxy Int16) "Int16"
81 checkUrlPiece (Proxy :: Proxy Int32) "Int32"
82 checkUrlPiece (Proxy :: Proxy Int64) "Int64"
83 checkUrlPiece (Proxy :: Proxy Integer) "Integer"
84 checkUrlPiece (Proxy :: Proxy Word) "Word"
85 checkUrlPiece (Proxy :: Proxy Word8) "Word8"
86 checkUrlPiece (Proxy :: Proxy Word16) "Word16"
87 checkUrlPiece (Proxy :: Proxy Word32) "Word32"
88 checkUrlPiece (Proxy :: Proxy Word64) "Word64"
89 checkUrlPiece (Proxy :: Proxy String) "String"
90 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
91 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
92 checkUrlPiece (Proxy :: Proxy Day) "Day"
93 checkUrlPiece (Proxy :: Proxy Version) "Version"
95 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
96 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
97 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
98 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
100 it "bad integers are rejected" $ do
101 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
103 it "bounds checking works" $ do
104 parseUrlPieceMaybe (T.pack "256") `shouldBe` (Nothing :: Maybe Int8)
105 parseUrlPieceMaybe (T.pack "-10") `shouldBe` (Nothing :: Maybe Word)