@@ -0,0 +1,76 @@
1+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
2+module QCSupport
3+ (
4+ NonEmpty(..)
5+ , limCheck
6+ , maybeP
7+ ) where
8+
9+import Control.Applicative ((<$>))
10+import Data.Attoparsec
11+import Data.Word (Word8)
12+-- import Debug.Trace
13+import System.Random (RandomGen, Random(..))
14+import Test.QuickCheck
15+import qualified Data.ByteString as S
16+import qualified Data.ByteString.Lazy as L
17+
18+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
19+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
20+ fromIntegral b :: Integer) g of
21+ (x,g') -> (fromIntegral x, g')
22+
23+newtype NonEmpty a = NonEmpty { nonEmpty :: a }
24+ deriving (Eq, Ord, Read, Show)
25+
26+instance Functor NonEmpty where
27+ fmap f (NonEmpty a) = NonEmpty (f a)
28+
29+instance Applicative NonEmpty where
30+ NonEmpty f <*> NonEmpty a = NonEmpty (f a)
31+ pure a = NonEmpty a
32+
33+instance Arbitrary a => Arbitrary (NonEmpty [a]) where
34+ arbitrary = NonEmpty <$> sized (\n -> choose (1,n+1) >>= vector)
35+ coarbitrary = coarbitrary . nonEmpty
36+
37+instance Arbitrary S.ByteString where
38+ arbitrary = S.pack <$> arbitrary
39+ coarbitrary = coarbitrary . S.unpack
40+
41+instance Arbitrary (NonEmpty S.ByteString) where
42+ arbitrary = fmap S.pack <$> arbitrary
43+ coarbitrary = coarbitrary . S.unpack . nonEmpty
44+
45+instance Arbitrary L.ByteString where
46+ arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
47+ ((L.fromChunks . map nonEmpty) <$> arbitrary)
48+ coarbitrary = coarbitrary . L.unpack
49+
50+instance Arbitrary (NonEmpty L.ByteString) where
51+ arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
52+ (fmap (L.fromChunks . map nonEmpty) <$> arbitrary)
53+ coarbitrary = coarbitrary . L.unpack . nonEmpty
54+
55+instance Random Word8 where
56+ randomR = integralRandomR
57+ random = randomR (minBound,maxBound)
58+
59+instance Arbitrary Word8 where
60+ arbitrary = choose (minBound, maxBound)
61+ coarbitrary _ = variant 0
62+
63+instance Arbitrary Char where
64+ arbitrary = choose (minBound, maxBound)
65+ coarbitrary _ = variant 0
66+
67+maybeP :: Parser a -> L.ByteString -> Maybe a
68+maybeP p s = case parse p s of
69+ (_, Left _err) -> Nothing
70+ (_, Right a) -> Just a
71+
72+limCheck :: Testable a => Int -> a -> IO ()
73+limCheck limit = check defaultConfig {
74+ configMaxTest = limit
75+ , configEvery = \_ _ -> ""
76+ }