diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-08-26 05:12:18 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-08-26 05:12:18 +0400 |
commit | 46bdd60f94fe2f9eedf6fc14146bccf41348e5bd (patch) | |
tree | 377bbc62de1d3ef6a9af10cd96fa65330bde11e3 | |
parent | 97a6f7ccc7fc87279e8046f9e49061619d8dcdd8 (diff) |
+ Added tests for generic decode & record selectors.
-rw-r--r-- | TODO.org | 2 | ||||
-rw-r--r-- | src/Data/BEncode.hs | 3 | ||||
-rw-r--r-- | tests/properties.hs | 21 |
3 files changed, 22 insertions, 4 deletions
@@ -1,4 +1,4 @@ | |||
1 | * DONE generic decode | 1 | * DONE generic decode |
2 | * TODO tests for generics with record selectors | 2 | * DONE tests for generics with record selectors |
3 | * TODO documentation | 3 | * TODO documentation |
4 | * TODO v0.1.1.0 (reason: Dict ty syn exposed) | 4 | * TODO v0.1.1.0 (reason: Dict ty syn exposed) |
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 87321f2..e270525 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -227,7 +227,8 @@ instance (GBEncodable a Dict, GBEncodable b Dict) | |||
227 | gto (a :*: b) = gto a <> gto b | 227 | gto (a :*: b) = gto a <> gto b |
228 | 228 | ||
229 | {-# INLINE gfrom #-} | 229 | {-# INLINE gfrom #-} |
230 | gfrom = error "gfrom: not implemented" | 230 | -- Just look at this! >.< |
231 | gfrom dict = (:*:) <$> gfrom dict <*> gfrom dict | ||
231 | 232 | ||
232 | 233 | ||
233 | instance (GBEncodable a e, GBEncodable b e) | 234 | instance (GBEncodable a e, GBEncodable b e) |
diff --git a/tests/properties.hs b/tests/properties.hs index 23371ba..12f3dfc 100644 --- a/tests/properties.hs +++ b/tests/properties.hs | |||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE DeriveGeneric #-} | 1 | {-# LANGUAGE DeriveGeneric #-} |
2 | {-# OPTIONS -fno-warn-unused-binds #-} | ||
2 | module Main (main) where | 3 | module Main (main) where |
3 | 4 | ||
4 | import Control.Applicative | 5 | import Control.Applicative |
@@ -39,14 +40,30 @@ instance Arbitrary a => Arbitrary (List a) where | |||
39 | , (10, Cons <$> arbitrary <*> arbitrary) | 40 | , (10, Cons <$> arbitrary <*> arbitrary) |
40 | ] | 41 | ] |
41 | 42 | ||
43 | data FileInfo = FileInfo | ||
44 | { fiLength :: !Integer | ||
45 | , fiPath :: [B.ByteString] | ||
46 | , fiMD5Sum :: B.ByteString | ||
47 | } deriving (Show, Eq, Generic) | ||
48 | |||
49 | instance BEncodable FileInfo | ||
50 | |||
51 | instance Arbitrary FileInfo where | ||
52 | arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary | ||
53 | |||
42 | data T a = T | 54 | data T a = T |
43 | 55 | ||
44 | prop_bencodable :: Eq a => BEncodable a => T a -> a -> Bool | 56 | prop_bencodable :: Eq a => BEncodable a => T a -> a -> Bool |
45 | prop_bencodable _ x = decoded (L.toStrict (encoded x)) == Right x | 57 | prop_bencodable _ x = decoded (L.toStrict (encoded x)) == Right x |
46 | 58 | ||
59 | -- All tests are (encode >>> decode = id) | ||
47 | main :: IO () | 60 | main :: IO () |
48 | main = defaultMain | 61 | main = defaultMain |
49 | [ testProperty "encode >>> decode = id" prop_EncDec | 62 | [ testProperty "BEncode" prop_EncDec |
50 | , testProperty "generic encode >>> decode = id" $ | 63 | |
64 | , testProperty "generic recordless" $ | ||
51 | prop_bencodable (T :: T (List Int)) | 65 | prop_bencodable (T :: T (List Int)) |
66 | |||
67 | , testProperty "generic records" $ | ||
68 | prop_bencodable (T :: T FileInfo) | ||
52 | ] \ No newline at end of file | 69 | ] \ No newline at end of file |