git.iko.soy/typeable/http-api-data
on 27f0a6f help sign in
typeable/http-api-data/test/Spec.hs
110 lines 4.2 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.PathPieces
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 -> Maybe a) -> a -> Bool
40(f <=> g) x = g (f x) == Just x
42data Proxy a = Proxy
44checkPathPiece :: forall a. (Eq a, PathPiece a, Show a, Arbitrary a) => Proxy a -> String -> Spec
45checkPathPiece _ name = prop ("toPathPiece <=> fromPathPiece " ++ name) (toPathPiece <=> fromPathPiece :: a -> Bool)
47checkPathMultiPiece :: forall a. (Eq a, PathMultiPiece a, Show a, Arbitrary a) => Proxy a -> String -> Spec
48checkPathMultiPiece _ name = prop ("toPathMultiPiece <=> fromPathMultiPiece " ++ name) (toPathMultiPiece <=> fromPathMultiPiece :: a -> Bool)
50data RandomCase a = RandomCase [Bool] a
52instance PathPiece a => Show (RandomCase a) where
53 show rc@(RandomCase _ x) = show (toPathPiece rc) ++ " (original: " ++ show (toPathPiece x) ++ ")"
55instance Eq a => Eq (RandomCase a) where
56 RandomCase _ x == RandomCase _ y = x == y
58instance Arbitrary a => Arbitrary (RandomCase a) where
59 arbitrary = liftA2 RandomCase nonempty arbitrary
60 where
61 nonempty = liftA2 (:) arbitrary arbitrary
63instance PathPiece a => PathPiece (RandomCase a) where
64 toPathPiece (RandomCase us x) = T.pack (zipWith (\u -> if u then toUpper else toLower) (cycle us) (T.unpack (toPathPiece x)))
65 fromPathPiece s = RandomCase [] <$> fromPathPiece s
67-- | Check case insensitivity for @fromPathPiece@.
68checkPathPieceI :: forall a. (Eq a, PathPiece a, Show a, Arbitrary a) => Proxy a -> String -> Spec
69checkPathPieceI _ = checkPathPiece (Proxy :: Proxy (RandomCase a))
71spec :: Spec
72spec = do
73 describe "PathPiece" $ do
74 checkPathPiece (Proxy :: Proxy ()) "()"
75 checkPathPiece (Proxy :: Proxy Char) "Char"
76 checkPathPieceI (Proxy :: Proxy Bool) "Bool"
77 checkPathPieceI (Proxy :: Proxy Ordering) "Ordering"
78 checkPathPiece (Proxy :: Proxy Int) "Int"
79 checkPathPiece (Proxy :: Proxy Int8) "Int8"
80 checkPathPiece (Proxy :: Proxy Int16) "Int16"
81 checkPathPiece (Proxy :: Proxy Int32) "Int32"
82 checkPathPiece (Proxy :: Proxy Int64) "Int64"
83 checkPathPiece (Proxy :: Proxy Integer) "Integer"
84 checkPathPiece (Proxy :: Proxy Word) "Word"
85 checkPathPiece (Proxy :: Proxy Word8) "Word8"
86 checkPathPiece (Proxy :: Proxy Word16) "Word16"
87 checkPathPiece (Proxy :: Proxy Word32) "Word32"
88 checkPathPiece (Proxy :: Proxy Word64) "Word64"
89 checkPathPiece (Proxy :: Proxy String) "String"
90 checkPathPiece (Proxy :: Proxy T.Text) "Text.Strict"
91 checkPathPiece (Proxy :: Proxy L.Text) "Text.Lazy"
92 checkPathPiece (Proxy :: Proxy Day) "Day"
93 checkPathPiece (Proxy :: Proxy Version) "Version"
95 checkPathPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
96 checkPathPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
97 checkPathPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"
98 checkPathPieceI (Proxy :: Proxy (Either Version Day)) "Either Version Day"
100 describe "PathMultiPiece" $ do
101 checkPathMultiPiece (Proxy :: Proxy [String]) "[String]"
102 checkPathMultiPiece (Proxy :: Proxy [T.Text]) "[Text]"
104 it "bad integers are rejected" $ do
105 fromPathPiece (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
107 it "bounds checking works" $ do
108 fromPathPiece (T.pack "256") `shouldBe` (Nothing :: Maybe Int8)
109 fromPathPiece (T.pack "-10") `shouldBe` (Nothing :: Maybe Word)