1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS -fno-warn-unused-binds #-}
module Main (main) where
import Control.Applicative
import Data.ByteString as BS
import Data.ByteString.Lazy as BL
import Data.List as L
import GHC.Generics
import Test.QuickCheck
import Test.Hspec
import Data.BEncode
import qualified Data.BEncode.BDict as BE
instance Arbitrary BS.ByteString where
arbitrary = BS.pack <$> arbitrary
instance Arbitrary a => Arbitrary (BE.BDictMap a) where
arbitrary = frequency
[ (90, pure BE.Nil)
, (10, BE.Cons <$> arbitrary <*> arbitrary <*> arbitrary)
]
instance Arbitrary BValue where
arbitrary = frequency
[ (30, BInteger <$> arbitrary)
, (30, BString <$> arbitrary)
, (20, BList <$> (arbitrary `suchThat` ((10 >) . L.length)))
, (20, BDict <$> arbitrary)
]
data List a = Cons a (List a) | Nil
deriving (Show, Eq, Generic)
instance BEncode a => BEncode (List a)
instance Arbitrary a => Arbitrary (List a) where
arbitrary = frequency
[ (90, pure Nil)
, (10, Cons <$> arbitrary <*> arbitrary)
]
data FileInfo = FileInfo
{ fiLength :: !Integer
, fiPath :: [BS.ByteString]
, fiMD5Sum :: BS.ByteString
} deriving (Show, Eq, Generic)
instance BEncode FileInfo
instance Arbitrary FileInfo where
arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary
data T a = T
prop_bencodable :: Eq a => BEncode a => T a -> a -> Bool
prop_bencodable _ x = decode (BL.toStrict (encode x)) == Right x
main :: IO ()
main = hspec $ do
describe "BValue" $ do
it "properly encoded" $ property $
prop_bencodable (T :: T BValue)
describe "BEncode" $ do
it "generic recordless" $ property $
prop_bencodable (T :: T (List Int))
it "generic records" $ property $
prop_bencodable (T :: T FileInfo)
describe "Get" $ do
it "catchable from pure code" $ do
fromDict (fail "fatal error" :: Get Int) (BDict BE.Nil)
`shouldBe`
Left "fatal error"
|
