@@ -5,6 +5,7 @@ module Main where
55import Control.Applicative
66
77import Data.Int
8+import Data.Char
89import Data.Word
910import Data.Time
1011import qualified Data.Text as T
@@ -38,37 +39,67 @@ main = hspec spec
3839(<=>) :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool
3940(f <=> g) x = g (f x) == Just x
4041
42+data Proxy a = Proxy
43+
44+checkPathPiece :: forall a. (Eq a, PathPiece a, Show a, Arbitrary a) => Proxy a -> String -> Spec
45+checkPathPiece _ name = prop ("toPathPiece <=> fromPathPiece " ++ name) (toPathPiece <=> fromPathPiece :: a -> Bool)
46+
47+checkPathMultiPiece :: forall a. (Eq a, PathMultiPiece a, Show a, Arbitrary a) => Proxy a -> String -> Spec
48+checkPathMultiPiece _ name = prop ("toPathMultiPiece <=> fromPathMultiPiece " ++ name) (toPathMultiPiece <=> fromPathMultiPiece :: a -> Bool)
49+
50+data RandomCase a = RandomCase [Bool] a
51+
52+instance PathPiece a => Show (RandomCase a) where
53+ show rc@(RandomCase _ x) = show (toPathPiece rc) ++ " (original: " ++ show (toPathPiece x) ++ ")"
54+
55+instance Eq a => Eq (RandomCase a) where
56+ RandomCase _ x == RandomCase _ y = x == y
57+
58+instance Arbitrary a => Arbitrary (RandomCase a) where
59+ arbitrary = liftA2 RandomCase nonempty arbitrary
60+ where
61+ nonempty = liftA2 (:) arbitrary arbitrary
62+
63+instance 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
66+
67+-- | Check case insensitivity for @fromPathPiece@.
68+checkPathPieceI :: forall a. (Eq a, PathPiece a, Show a, Arbitrary a) => Proxy a -> String -> Spec
69+checkPathPieceI _ = checkPathPiece (Proxy :: Proxy (RandomCase a))
70+
4171spec :: Spec
4272spec = do
4373 describe "PathPiece" $ do
44− prop "toPathPiece <=> fromPathPiece ()" $ \(p :: ()) -> (toPathPiece <=> fromPathPiece) p
45− prop "toPathPiece <=> fromPathPiece Char" $ \(p :: Char) -> (toPathPiece <=> fromPathPiece) p
46− prop "toPathPiece <=> fromPathPiece Bool" $ \(p :: Bool) -> (toPathPiece <=> fromPathPiece) p
47− prop "toPathPiece <=> fromPathPiece Ordering" $ \(p :: Ordering) -> (toPathPiece <=> fromPathPiece) p
48− prop "toPathPiece <=> fromPathPiece Int" $ \(p :: Int) -> (toPathPiece <=> fromPathPiece) p
49− prop "toPathPiece <=> fromPathPiece Int8" $ \(p :: Int8) -> (toPathPiece <=> fromPathPiece) p
50− prop "toPathPiece <=> fromPathPiece Int16" $ \(p :: Int16) -> (toPathPiece <=> fromPathPiece) p
51− prop "toPathPiece <=> fromPathPiece Int32" $ \(p :: Int32) -> (toPathPiece <=> fromPathPiece) p
52− prop "toPathPiece <=> fromPathPiece Int64" $ \(p :: Int64) -> (toPathPiece <=> fromPathPiece) p
53− prop "toPathPiece <=> fromPathPiece Integer" $ \(p :: Integer) -> (toPathPiece <=> fromPathPiece) p
54− prop "toPathPiece <=> fromPathPiece Word" $ \(p :: Word) -> (toPathPiece <=> fromPathPiece) p
55− prop "toPathPiece <=> fromPathPiece Word8" $ \(p :: Word8) -> (toPathPiece <=> fromPathPiece) p
56− prop "toPathPiece <=> fromPathPiece Word16" $ \(p :: Word16) -> (toPathPiece <=> fromPathPiece) p
57− prop "toPathPiece <=> fromPathPiece Word32" $ \(p :: Word32) -> (toPathPiece <=> fromPathPiece) p
58− prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
59− prop "toPathPiece <=> fromPathPiece Word64" $ \(p :: Word64) -> (toPathPiece <=> fromPathPiece) p
60− prop "toPathPiece <=> fromPathPiece String" $ \(p :: String) -> (toPathPiece <=> fromPathPiece) p
61− prop "toPathPiece <=> fromPathPiece Text.Strict" $ \(p :: T.Text) -> (toPathPiece <=> fromPathPiece) p
62− prop "toPathPiece <=> fromPathPiece Text.Lazy" $ \(p :: L.Text) -> (toPathPiece <=> fromPathPiece) p
63− prop "toPathPiece <=> fromPathPiece Day" $ \(p :: Day) -> (toPathPiece <=> fromPathPiece) p
64− prop "toPathPiece <=> fromPathPiece Version" $ \(p :: Version) -> (toPathPiece <=> fromPathPiece) p
65−
66− prop "toPathPiece <=> fromPathPiece Maybe String" $ \(p::Maybe String) -> (toPathPiece <=> fromPathPiece) p
67− prop "toPathPiece <=> fromPathPiece Either Integer Text" $ \(p::Either Integer T.Text) -> (toPathPiece <=> fromPathPiece) p
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"
94+
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"
6899
69100 describe "PathMultiPiece" $ do
70− prop "toPathMultiPiece <=> fromPathMultiPiece String" $ \(p::[String]) -> (toPathMultiPiece <=> fromPathMultiPiece) p
71− prop "toPathMultiPiece <=> fromPathMultiPiece Text" $ \(p::[T.Text]) -> (toPathMultiPiece <=> fromPathMultiPiece) p
101+ checkPathMultiPiece (Proxy :: Proxy [String]) "[String]"
102+ checkPathMultiPiece (Proxy :: Proxy [T.Text]) "[Text]"
72103
73104 it "bad integers are rejected" $ do
74105 fromPathPiece (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)