diff options
-rw-r--r-- | tests/properties.hs | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/tests/properties.hs b/tests/properties.hs index 41950e7..23371ba 100644 --- a/tests/properties.hs +++ b/tests/properties.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# LANGUAGE DeriveGeneric #-} | ||
1 | module Main (main) where | 2 | module Main (main) where |
2 | 3 | ||
3 | import Control.Applicative | 4 | import Control.Applicative |
@@ -6,9 +7,11 @@ import qualified Data.ByteString.Lazy as L | |||
6 | import Test.Framework (defaultMain) | 7 | import Test.Framework (defaultMain) |
7 | import Test.Framework.Providers.QuickCheck2 (testProperty) | 8 | import Test.Framework.Providers.QuickCheck2 (testProperty) |
8 | import Test.QuickCheck | 9 | import Test.QuickCheck |
10 | import GHC.Generics | ||
9 | 11 | ||
10 | import Data.BEncode | 12 | import Data.BEncode |
11 | 13 | ||
14 | |||
12 | instance Arbitrary B.ByteString where | 15 | instance Arbitrary B.ByteString where |
13 | arbitrary = fmap B.pack arbitrary | 16 | arbitrary = fmap B.pack arbitrary |
14 | 17 | ||
@@ -19,12 +22,31 @@ instance Arbitrary BEncode where | |||
19 | , (5, BList <$> (arbitrary `suchThat` ((10 >) . length))) | 22 | , (5, BList <$> (arbitrary `suchThat` ((10 >) . length))) |
20 | ] | 23 | ] |
21 | 24 | ||
25 | |||
22 | prop_EncDec :: BEncode -> Bool | 26 | prop_EncDec :: BEncode -> Bool |
23 | prop_EncDec x = case decode (L.toStrict (encode x)) of | 27 | prop_EncDec x = case decode (L.toStrict (encode x)) of |
24 | Left _ -> False | 28 | Left _ -> False |
25 | Right x' -> x == x' | 29 | Right x' -> x == x' |
26 | 30 | ||
31 | data List a = Cons a (List a) | Nil | ||
32 | deriving (Show, Eq, Generic) | ||
33 | |||
34 | instance BEncodable a => BEncodable (List a) | ||
35 | |||
36 | instance Arbitrary a => Arbitrary (List a) where | ||
37 | arbitrary = frequency | ||
38 | [ (90, pure Nil) | ||
39 | , (10, Cons <$> arbitrary <*> arbitrary) | ||
40 | ] | ||
41 | |||
42 | data T a = T | ||
43 | |||
44 | prop_bencodable :: Eq a => BEncodable a => T a -> a -> Bool | ||
45 | prop_bencodable _ x = decoded (L.toStrict (encoded x)) == Right x | ||
46 | |||
27 | main :: IO () | 47 | main :: IO () |
28 | main = defaultMain | 48 | main = defaultMain |
29 | [ testProperty "encode <-> decode" prop_EncDec | 49 | [ testProperty "encode >>> decode = id" prop_EncDec |
50 | , testProperty "generic encode >>> decode = id" $ | ||
51 | prop_bencodable (T :: T (List Int)) | ||
30 | ] \ No newline at end of file | 52 | ] \ No newline at end of file |