@@ -3,7 +3,8 @@
33
44module QC.Buffer (tests) where
55
6−import Data.Monoid (mconcat)
6+import Control.Applicative ((<$>))
7+import Data.Monoid (Monoid(mconcat))
78import QC.Common ()
89import Test.Framework (Test)
910import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -24,12 +25,19 @@ type BPT = BP T.Text BT.Buffer
2425instance Arbitrary BPB where
2526 arbitrary = do
2627 bss <- arbitrary
27− return $! BP bss (mconcat bss) (mconcat (map BB.buffer bss))
28+ return $! toBP BB.buffer bss
29+
30+ shrink (BP bss _ _) = toBP BB.buffer <$> shrink bss
2831
2932instance Arbitrary BPT where
3033 arbitrary = do
3134 bss <- arbitrary
32− return $! BP bss (mconcat bss) (mconcat (map BT.buffer bss))
35+ return $! toBP BT.buffer bss
36+
37+ shrink (BP bss _ _) = toBP BT.buffer <$> shrink bss
38+
39+toBP :: (Monoid a, Monoid b) => (a -> b) -> [a] -> BP a b
40+toBP buf bss = BP bss (mconcat bss) (mconcat (map buf bss))
3341
3442b_unbuffer :: BPB -> Property
3543b_unbuffer (BP _ts t buf) = t === BB.unbuffer buf