summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tests/properties.hs24
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 #-}
1module Main (main) where 2module Main (main) where
2 3
3import Control.Applicative 4import Control.Applicative
@@ -6,9 +7,11 @@ import qualified Data.ByteString.Lazy as L
6import Test.Framework (defaultMain) 7import Test.Framework (defaultMain)
7import Test.Framework.Providers.QuickCheck2 (testProperty) 8import Test.Framework.Providers.QuickCheck2 (testProperty)
8import Test.QuickCheck 9import Test.QuickCheck
10import GHC.Generics
9 11
10import Data.BEncode 12import Data.BEncode
11 13
14
12instance Arbitrary B.ByteString where 15instance 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
22prop_EncDec :: BEncode -> Bool 26prop_EncDec :: BEncode -> Bool
23prop_EncDec x = case decode (L.toStrict (encode x)) of 27prop_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
31data List a = Cons a (List a) | Nil
32 deriving (Show, Eq, Generic)
33
34instance BEncodable a => BEncodable (List a)
35
36instance Arbitrary a => Arbitrary (List a) where
37 arbitrary = frequency
38 [ (90, pure Nil)
39 , (10, Cons <$> arbitrary <*> arbitrary)
40 ]
41
42data T a = T
43
44prop_bencodable :: Eq a => BEncodable a => T a -> a -> Bool
45prop_bencodable _ x = decoded (L.toStrict (encoded x)) == Right x
46
27main :: IO () 47main :: IO ()
28main = defaultMain 48main = 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