module Data.GenValidity
( module Data.Validity
, module Data.GenValidity
) where
import Data.Validity
import Test.QuickCheck
import Control.Monad (forM)
class GenUnchecked a where
genUnchecked :: Gen a
class (Validity a, GenUnchecked a) =>
GenValid a where
genValid :: Gen a
genValid = genUnchecked `suchThat` isValid
class (Validity a, GenUnchecked a) =>
GenInvalid a where
genInvalid :: Gen a
genInvalid = genUnchecked `suchThat` (not . isValid)
instance (GenUnchecked a, GenUnchecked b) =>
GenUnchecked (a, b) where
genUnchecked =
sized $ \n -> do
(r, s) <- genSplit n
a <- resize r genUnchecked
b <- resize s genUnchecked
return (a, b)
instance (GenValid a, GenValid b) =>
GenValid (a, b) where
genValid =
sized $ \n -> do
(r, s) <- genSplit n
a <- resize r genValid
b <- resize s genValid
return (a, b)
instance (GenInvalid a, GenInvalid b) =>
GenInvalid (a, b) where
genInvalid =
sized $ \n -> do
(r, s) <- genSplit n
oneof
[ do a <- resize r genUnchecked
b <- resize s genInvalid
return (a, b)
, do a <- resize r genInvalid
b <- resize s genUnchecked
return (a, b)
]
instance (GenUnchecked a, GenUnchecked b) =>
GenUnchecked (Either a b) where
genUnchecked = oneof [Left <$> genUnchecked, Right <$> genUnchecked]
instance (GenValid a, GenValid b) =>
GenValid (Either a b) where
genValid = oneof [Left <$> genValid, Right <$> genValid]
instance (GenInvalid a, GenInvalid b) =>
GenInvalid (Either a b) where
genInvalid = oneof [Left <$> genInvalid, Right <$> genInvalid]
instance (GenUnchecked a, GenUnchecked b, GenUnchecked c) =>
GenUnchecked (a, b, c) where
genUnchecked =
sized $ \n -> do
(r, s, t) <- genSplit3 n
a <- resize r genUnchecked
b <- resize s genUnchecked
c <- resize t genUnchecked
return (a, b, c)
instance (GenValid a, GenValid b, GenValid c) =>
GenValid (a, b, c) where
genValid =
sized $ \n -> do
(r, s, t) <- genSplit3 n
a <- resize r genValid
b <- resize s genValid
c <- resize t genValid
return (a, b, c)
instance (GenInvalid a, GenInvalid b, GenInvalid c) =>
GenInvalid (a, b, c) where
genInvalid =
sized $ \n -> do
(r, s, t) <- genSplit3 n
oneof
[ do a <- resize r genInvalid
b <- resize s genUnchecked
c <- resize t genUnchecked
return (a, b, c)
, do a <- resize r genUnchecked
b <- resize s genInvalid
c <- resize t genUnchecked
return (a, b, c)
, do a <- resize r genUnchecked
b <- resize s genUnchecked
c <- resize t genInvalid
return (a, b, c)
]
instance GenUnchecked a =>
GenUnchecked (Maybe a) where
genUnchecked = oneof [pure Nothing, Just <$> genUnchecked]
instance GenValid a =>
GenValid (Maybe a) where
genValid = oneof [pure Nothing, Just <$> genValid]
instance GenInvalid a =>
GenInvalid (Maybe a) where
genInvalid = Just <$> genInvalid
instance GenUnchecked a =>
GenUnchecked [a] where
genUnchecked = genListOf genUnchecked
instance GenValid a =>
GenValid [a] where
genValid = genListOf genValid
instance GenInvalid a =>
GenInvalid [a] where
genInvalid =
sized $ \n -> do
(x, y, z) <- genSplit3 n
before <- resize x $ genListOf genUnchecked
middle <- resize y genInvalid
after <- resize z $ genListOf genUnchecked
return $ before ++ [middle] ++ after
instance GenUnchecked () where
genUnchecked = arbitrary
instance GenValid ()
instance GenUnchecked Bool where
genUnchecked = arbitrary
instance GenValid Bool
instance GenUnchecked Ordering where
genUnchecked = arbitrary
instance GenValid Ordering
instance GenUnchecked Char where
genUnchecked = arbitrary
instance GenValid Char
instance GenUnchecked Int where
genUnchecked = arbitrary
instance GenValid Int
instance GenUnchecked Word where
genUnchecked = arbitrary
instance GenValid Word
instance GenUnchecked Float where
genUnchecked = arbitrary
instance GenValid Float where
genValid = arbitrary
instance GenInvalid Float where
genInvalid = elements [read "NaN", read "Infinity"]
instance GenUnchecked Double where
genUnchecked = arbitrary
instance GenValid Double
instance GenInvalid Double where
genInvalid = elements [read "NaN", read "Infinity"]
instance GenUnchecked Integer where
genUnchecked = arbitrary
instance GenValid Integer
upTo :: Int -> Gen Int
upTo n
| n <= 0 = pure 0
| otherwise = elements [0 .. n]
genSplit :: Int -> Gen (Int, Int)
genSplit n
| n < 0 = pure (0, 0)
| otherwise = elements [(i, n i) | i <- [0 .. n]]
genSplit3 :: Int -> Gen (Int, Int, Int)
genSplit3 n
| n < 0 = pure (0, 0, 0)
| otherwise = do
(a, z) <- genSplit n
(b, c) <- genSplit z
return (a, b, c)
arbPartition :: Int -> Gen [Int]
arbPartition k
| k <= 0 = pure []
| otherwise = do
first <- elements [1 .. k]
rest <- arbPartition $ k first
return $ first : rest
genListOf :: Gen a -> Gen [a]
genListOf func =
sized $ \n -> do
size <- upTo n
pars <- arbPartition size
forM pars $ \i -> resize i func