module Test.GMap.Utils where
import Test.QuickCheck
import Data.GMap
import Data.GMap.ChoiceMap
import qualified Data.List as L
import Control.Monad(liftM)
import Data.GMap.AssocList
import System.Random(newStdGen)
gen n g = do
stdg <- newStdGen
return $ generate n stdg g
on f g a b = f (g a b)
instance Show (a->b) where
show _ = "<function>"
instance (OrderedMap map k, Arbitrary k, Arbitrary a) => Arbitrary (map a) where
arbitrary = liftM fromAssocs (arbitrary :: Gen [(k,a)])
coarbitrary mp = coarbitrary (assocs mp)
instance (OrderedMap map k, Show k, Show a) => Show (map a) where
show map = "fromAssocs " ++ (show $ assocs map)
instance Arbitrary Char where
arbitrary = sized $ \n -> choose (minBound , maxBound `min` (toEnum n))
coarbitrary c = variant (fromEnum c)
instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e) => Arbitrary (a,b,c,d,e) where
arbitrary = do
(a,b,c,(d,e)) <- arbitrary
return (a,b,c,d,e)
coarbitrary (a,b,c,d,e) = coarbitrary (a,b,c,(d,e))
instance (Arbitrary a, Arbitrary b) => Arbitrary (Choice2 a b) where
arbitrary = oneof [C1of2 `fmap` arbitrary, C2of2 `fmap` arbitrary]
coarbitrary choice = case choice of
C1of2 a -> coarbitrary a
C2of2 b -> coarbitrary b
instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Choice3 a b c) where
arbitrary = oneof [C1of3 `fmap` arbitrary, C2of3 `fmap` arbitrary, C3of3 `fmap` arbitrary]
coarbitrary choice = case choice of
C1of3 a -> coarbitrary a
C2of3 b -> coarbitrary b
C3of3 c -> coarbitrary c
instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (Choice4 a b c d) where
arbitrary = oneof [C1of4 `fmap` arbitrary, C2of4 `fmap` arbitrary, C3of4 `fmap` arbitrary, C4of4 `fmap` arbitrary]
coarbitrary choice = case choice of
C1of4 a -> coarbitrary a
C2of4 b -> coarbitrary b
C3of4 c -> coarbitrary c
C4of4 d -> coarbitrary d
instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e) => Arbitrary (Choice5 a b c d e) where
arbitrary = oneof [C1of5 `fmap` arbitrary, C2of5 `fmap` arbitrary, C3of5 `fmap` arbitrary, C4of5 `fmap` arbitrary, C5of5 `fmap` arbitrary]
coarbitrary choice = case choice of
C1of5 a -> coarbitrary a
C2of5 b -> coarbitrary b
C3of5 c -> coarbitrary c
C4of5 d -> coarbitrary d
C5of5 e -> coarbitrary e
like = const :: a -> a -> a
likeElem = const :: OrderedMap map k => a -> map a -> a
likeMaybeElem = const :: OrderedMap map k => Maybe a -> map a -> Maybe a
data Test m1 m2 where
SimpleTest :: Testable b => (m1 -> b) -> Test m1 m2
SimpleTest2 :: Testable b => ((m1,m1) -> b) -> Test m1 m2
CompareTest :: (Arbitrary a, Show a, Eq b) =>
(m1 -> a -> b) -> (m2 -> a -> b) -> Test m1 m2
CompareTest2 :: (Arbitrary a, Show a, Eq b) =>
((m1,m1) -> a -> b) -> ((m2,m2) -> a -> b) -> Test m1 m2
compareTest :: (OrderedMap mp1 k, OrderedMap mp2 k, Arbitrary a, Show a, Eq b, Ord k) => (forall mp. (OrderedMap mp k, Eq k, Ord k) => (mp e) -> a -> b) -> Test (mp1 e) (mp2 e)
compareTest f = CompareTest f f
compareTest2 :: (OrderedMap mp1 k, OrderedMap mp2 k, Arbitrary a, Show a, Eq b, Ord k) => (forall mp. (OrderedMap mp k, Eq k, Ord k) => ((mp e),(mp e)) -> a -> b) -> Test (mp1 e) (mp2 e)
compareTest2 f = CompareTest2 f f
instance (OrderedMap mp1 k, OrderedMap mp2 k, Show (mp1 a), Show (mp2 a), Arbitrary k, Arbitrary a, Show k, Show a) => Testable (Test (mp1 a) (mp2 a)) where
property (SimpleTest f) = property f
property (SimpleTest2 f) = property f
property (CompareTest f1 f2) = property (\ kas a -> f1 (fromAssocs kas) a == f2 (fromAssocs kas) a)
property (CompareTest2 f1 f2) = property (\ kas1 kas2 a -> f1 (fromAssocs kas1, fromAssocs kas2) a == f2 (fromAssocs kas1, fromAssocs kas2) a)
testList file prefix code = do
source <- readFile file
let props = L.filter (\l -> (L.isPrefixOf prefix l) && (not $ L.isPrefixOf (prefix ++ " ::") l)) $
L.map head $ L.filter (not.null) $ L.map words $ lines source
let printProp prop = do
putStr "("
putStr (code ++ prop)
putStr ",\""
putStr prop
putStr "\")"
putStr "["
printProp $ head props
mapM_ (\prop -> do
putStr ","
printProp prop) $ tail props
putStrLn "]"
config n = Config
{ configMaxTest = n
, configMaxFail = 1000
, configSize = (+ 3) . (`div` 2)
, configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
}
type Tests m1 m2 = [(Test m1 m2, String)]
runTests :: (Testable (Test m1 m2)) => Tests m1 m2 -> Int -> IO ()
runTests tests n =
mapM_ ( \ (prop,name) -> do
putStr name
putStr " : "
check (config n) prop ) tests
runAListTest :: (OrderedMap mp k, Testable (Test (mp a) (AList k a))) => (mp a) -> Tests (mp a) (AList k a) -> Int -> IO ()
runSListTest :: (OrderedMap mp k, Testable (Test (mp a) (SList mp k a))) => (mp a) -> Tests (mp a) (SList mp k a) -> Int -> IO ()
runAListTest _ = runTests
runSListTest _ = runTests