git.iko.soy/typeable/http-api-data
on cdc4b93 help sign in
typeable/http-api-data/test/Spec.hs
105 lines 3.9 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 Version where
31 arbitrary = (version . map abs) <$> nonempty
32 where
33 version branch = Version branch []
34 nonempty = liftA2 (:) arbitrary arbitrary
36main :: IO ()
37main = hspec spec
39(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
40(f <=> g) x = g (f x) == Right x
42data Proxy a = Proxy
44checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
45checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
47data RandomCase a = RandomCase [Bool] a
49instance ToHttpApiData a => Show (RandomCase a) where
50 show rc@(RandomCase _ x) = show (toUrlPiece rc) ++ " (original: " ++ show (toUrlPiece x) ++ ")"
52instance Eq a => Eq (RandomCase a) where
53 RandomCase _ x == RandomCase _ y = x == y
55instance Arbitrary a => Arbitrary (RandomCase a) where
56 arbitrary = liftA2 RandomCase nonempty arbitrary
57 where
58 nonempty = liftA2 (:) arbitrary arbitrary
60instance ToHttpApiData a => ToHttpApiData (RandomCase a) where
61 toUrlPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toUrlPiece x)))
63instance FromHttpApiData a => FromHttpApiData (RandomCase a) where
64 parseUrlPiece s = RandomCase [] <$> parseUrlPiece s
66-- | Check case insensitivity for @parseUrlPiece@.
67checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
68checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
70spec :: Spec
71spec = do
72 describe "toUrlPiece <=> parseUrlPiece" $ do
73 checkUrlPiece (Proxy :: Proxy ()) "()"
74 checkUrlPiece (Proxy :: Proxy Char) "Char"
75 checkUrlPieceI (Proxy :: Proxy Bool) "Bool"
76 checkUrlPieceI (Proxy :: Proxy Ordering) "Ordering"
77 checkUrlPiece (Proxy :: Proxy Int) "Int"
78 checkUrlPiece (Proxy :: Proxy Int8) "Int8"
79 checkUrlPiece (Proxy :: Proxy Int16) "Int16"
80 checkUrlPiece (Proxy :: Proxy Int32) "Int32"
81 checkUrlPiece (Proxy :: Proxy Int64) "Int64"
82 checkUrlPiece (Proxy :: Proxy Integer) "Integer"
83 checkUrlPiece (Proxy :: Proxy Word) "Word"
84 checkUrlPiece (Proxy :: Proxy Word8) "Word8"
85 checkUrlPiece (Proxy :: Proxy Word16) "Word16"
86 checkUrlPiece (Proxy :: Proxy Word32) "Word32"
87 checkUrlPiece (Proxy :: Proxy Word64) "Word64"
88 checkUrlPiece (Proxy :: Proxy String) "String"
89 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
90 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
91 checkUrlPiece (Proxy :: Proxy Day) "Day"
92 checkUrlPiece (Proxy :: Proxy Version) "Version"
94 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
95 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
96 checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
97 checkUrlPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
99 it "bad integers are rejected" $ do
100 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
102 it "bounds checking works" $ do
103 parseUrlPieceMaybe (T.pack "256") `shouldBe` (Nothing :: Maybe Int8)
104 parseUrlPieceMaybe (T.pack "-10") `shouldBe` (Nothing :: Maybe Word)