{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.GenValidity
( GenValid (..),
genValidStructurally,
genValidStructurallyWithoutExtraChecking,
shrinkValidStructurally,
shrinkValidStructurallyWithoutExtraFiltering,
module Data.GenValidity.Utils,
genUtf16SurrogateCodePoint,
genLineSeparator,
genNonLineSeparator,
genSingleLineString,
module Data.Validity,
GGenValid (..),
GValidRecursivelyShrink (..),
structurallyValidSubterms,
GValidSubterms (..),
GValidSubtermsIncl (..),
)
where
import Control.Monad (guard)
import Data.Char (chr)
import Data.Fixed (Fixed (..), HasResolution)
import Data.GenValidity.Utils
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Ratio ((%))
import Data.Validity
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics
import GHC.Real (Ratio (..))
import Numeric.Natural
import Test.QuickCheck hiding (Fixed)
{-# ANN module "HLint: ignore Reduce duplication" #-}
class Validity a => GenValid a where
genValid :: Gen a
default genValid :: (Generic a, GGenValid (Rep a)) => Gen a
genValid = Gen a
forall a. (Validity a, Generic a, GGenValid (Rep a)) => Gen a
genValidStructurally
shrinkValid :: a -> [a]
default shrinkValid :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
shrinkValid = a -> [a]
forall a.
(Validity a, Generic a, GValidRecursivelyShrink (Rep a),
GValidSubterms (Rep a) a) =>
a -> [a]
shrinkValidStructurally
instance (GenValid a, GenValid b) => GenValid (a, b) where
genValid :: Gen (a, b)
genValid =
(Int -> Gen (a, b)) -> Gen (a, b)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (a, b)) -> Gen (a, b))
-> (Int -> Gen (a, b)) -> Gen (a, b)
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
(Int
r, Int
s) <- Int -> Gen (Int, Int)
genSplit Int
n
a
a <- Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
r Gen a
forall a. GenValid a => Gen a
genValid
b
b <- Int -> Gen b -> Gen b
forall a. Int -> Gen a -> Gen a
resize Int
s Gen b
forall a. GenValid a => Gen a
genValid
(a, b) -> Gen (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
shrinkValid :: (a, b) -> [(a, b)]
shrinkValid = (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid b -> [b]
forall a. GenValid a => a -> [a]
shrinkValid
instance (GenValid a, GenValid b) => GenValid (Either a b) where
genValid :: Gen (Either a b)
genValid = [Gen (Either a b)] -> Gen (Either a b)
forall a. [Gen a] -> Gen a
oneof [a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Gen a -> Gen (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. GenValid a => Gen a
genValid, b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Gen b -> Gen (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen b
forall a. GenValid a => Gen a
genValid]
shrinkValid :: Either a b -> [Either a b]
shrinkValid (Left a
a) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> [a] -> [Either a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid a
a
shrinkValid (Right b
b) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> [b] -> [Either a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> [b]
forall a. GenValid a => a -> [a]
shrinkValid b
b
instance (GenValid a, GenValid b, GenValid c) => GenValid (a, b, c) where
genValid :: Gen (a, b, c)
genValid =
(Int -> Gen (a, b, c)) -> Gen (a, b, c)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (a, b, c)) -> Gen (a, b, c))
-> (Int -> Gen (a, b, c)) -> Gen (a, b, c)
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
(Int
r, Int
s, Int
t) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
n
a
a <- Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
r Gen a
forall a. GenValid a => Gen a
genValid
b
b <- Int -> Gen b -> Gen b
forall a. Int -> Gen a -> Gen a
resize Int
s Gen b
forall a. GenValid a => Gen a
genValid
c
c <- Int -> Gen c -> Gen c
forall a. Int -> Gen a -> Gen a
resize Int
t Gen c
forall a. GenValid a => Gen a
genValid
(a, b, c) -> Gen (a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c)
shrinkValid :: (a, b, c) -> [(a, b, c)]
shrinkValid (a
a, b
b, c
c) =
[ (a
a', b
b', c
c')
| (a
a', (b
b', c
c')) <- (a, (b, c)) -> [(a, (b, c))]
forall a. GenValid a => a -> [a]
shrinkValid (a
a, (b
b, c
c))
]
instance
(GenValid a, GenValid b, GenValid c, GenValid d) =>
GenValid (a, b, c, d)
where
genValid :: Gen (a, b, c, d)
genValid =
(Int -> Gen (a, b, c, d)) -> Gen (a, b, c, d)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (a, b, c, d)) -> Gen (a, b, c, d))
-> (Int -> Gen (a, b, c, d)) -> Gen (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
(Int
r, Int
s, Int
t, Int
u) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
n
a
a <- Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
r Gen a
forall a. GenValid a => Gen a
genValid
b
b <- Int -> Gen b -> Gen b
forall a. Int -> Gen a -> Gen a
resize Int
s Gen b
forall a. GenValid a => Gen a
genValid
c
c <- Int -> Gen c -> Gen c
forall a. Int -> Gen a -> Gen a
resize Int
t Gen c
forall a. GenValid a => Gen a
genValid
d
d <- Int -> Gen d -> Gen d
forall a. Int -> Gen a -> Gen a
resize Int
u Gen d
forall a. GenValid a => Gen a
genValid
(a, b, c, d) -> Gen (a, b, c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d)
shrinkValid :: (a, b, c, d) -> [(a, b, c, d)]
shrinkValid (a
a, b
b, c
c, d
d) =
[ (a
a', b
b', c
c', d
d')
| (a
a', (b
b', (c
c', d
d'))) <- (a, (b, (c, d))) -> [(a, (b, (c, d)))]
forall a. GenValid a => a -> [a]
shrinkValid (a
a, (b
b, (c
c, d
d)))
]
instance
(GenValid a, GenValid b, GenValid c, GenValid d, GenValid e) =>
GenValid (a, b, c, d, e)
where
genValid :: Gen (a, b, c, d, e)
genValid =
(Int -> Gen (a, b, c, d, e)) -> Gen (a, b, c, d, e)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (a, b, c, d, e)) -> Gen (a, b, c, d, e))
-> (Int -> Gen (a, b, c, d, e)) -> Gen (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
(Int
r, Int
s, Int
t, Int
u, Int
v) <- Int -> Gen (Int, Int, Int, Int, Int)
genSplit5 Int
n
a
a <- Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
r Gen a
forall a. GenValid a => Gen a
genValid
b
b <- Int -> Gen b -> Gen b
forall a. Int -> Gen a -> Gen a
resize Int
s Gen b
forall a. GenValid a => Gen a
genValid
c
c <- Int -> Gen c -> Gen c
forall a. Int -> Gen a -> Gen a
resize Int
t Gen c
forall a. GenValid a => Gen a
genValid
d
d <- Int -> Gen d -> Gen d
forall a. Int -> Gen a -> Gen a
resize Int
u Gen d
forall a. GenValid a => Gen a
genValid
e
e <- Int -> Gen e -> Gen e
forall a. Int -> Gen a -> Gen a
resize Int
v Gen e
forall a. GenValid a => Gen a
genValid
(a, b, c, d, e) -> Gen (a, b, c, d, e)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e)
shrinkValid :: (a, b, c, d, e) -> [(a, b, c, d, e)]
shrinkValid (a
a, b
b, c
c, d
d, e
e) =
[ (a
a', b
b', c
c', d
d', e
e')
| (a
a', (b
b', (c
c', (d
d', e
e')))) <- (a, (b, (c, (d, e)))) -> [(a, (b, (c, (d, e))))]
forall a. GenValid a => a -> [a]
shrinkValid (a
a, (b
b, (c
c, (d
d, e
e))))
]
instance GenValid a => GenValid (Maybe a) where
genValid :: Gen (Maybe a)
genValid = [Gen (Maybe a)] -> Gen (Maybe a)
forall a. [Gen a] -> Gen a
oneof [Maybe a -> Gen (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. GenValid a => Gen a
genValid]
shrinkValid :: Maybe a -> [Maybe a]
shrinkValid Maybe a
Nothing = []
shrinkValid (Just a
a) = Maybe a
forall a. Maybe a
Nothing Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> [a] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid a
a)
instance GenValid a => GenValid (NonEmpty a) where
genValid :: Gen (NonEmpty a)
genValid = Gen a -> Gen (NonEmpty a)
forall a. Gen a -> Gen (NonEmpty a)
genNonEmptyOf Gen a
forall a. GenValid a => Gen a
genValid
shrinkValid :: NonEmpty a -> [NonEmpty a]
shrinkValid (a
v :| [a]
vs) = [a
e a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
es | (a
e, [a]
es) <- (a, [a]) -> [(a, [a])]
forall a. GenValid a => a -> [a]
shrinkValid (a
v, [a]
vs)]
instance GenValid a => GenValid [a] where
genValid :: Gen [a]
genValid = Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
forall a. GenValid a => Gen a
genValid
shrinkValid :: [a] -> [[a]]
shrinkValid = (a -> [a]) -> [a] -> [[a]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
instance GenValid () where
genValid :: Gen ()
genValid = () -> Gen ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
shrinkValid :: () -> [()]
shrinkValid () = []
instance GenValid Bool where
genValid :: Gen Bool
genValid = Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
shrinkValid :: Bool -> [Bool]
shrinkValid = Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Ordering where
genValid :: Gen Ordering
genValid = Gen Ordering
forall a. Arbitrary a => Gen a
arbitrary
shrinkValid :: Ordering -> [Ordering]
shrinkValid = Ordering -> [Ordering]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Char where
genValid :: Gen Char
genValid =
[(Int, Gen Char)] -> Gen Char
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
9, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
forall a. Bounded a => a
minBound, Char
forall a. Bounded a => a
maxBound)),
(Int
1, Gen Char
genUtf16SurrogateCodePoint)
]
shrinkValid :: Char -> [Char]
shrinkValid = Char -> [Char]
forall a. Arbitrary a => a -> [a]
shrink
genUtf16SurrogateCodePoint :: Gen Char
genUtf16SurrogateCodePoint :: Gen Char
genUtf16SurrogateCodePoint = Int -> Char
chr (Int -> Char) -> Gen Int -> Gen Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Int] -> Gen Int
forall a. [Gen a] -> Gen a
oneof [(Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0xD800, Int
0xDBFF), (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0xDC00, Int
0xDFFF)]
genLineSeparator :: Gen Char
genLineSeparator :: Gen Char
genLineSeparator = [Char] -> Gen Char
forall a. [a] -> Gen a
elements [Char
'\n', Char
'\r']
genNonLineSeparator :: Gen Char
genNonLineSeparator :: Gen Char
genNonLineSeparator = Gen Char
forall a. GenValid a => Gen a
genValid Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isLineSeparator)
genSingleLineString :: Gen String
genSingleLineString :: Gen [Char]
genSingleLineString = Gen Char -> Gen [Char]
forall a. Gen a -> Gen [a]
genListOf Gen Char
genNonLineSeparator
instance GenValid Int where
genValid :: Gen Int
genValid = Gen Int
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
shrinkValid :: Int -> [Int]
shrinkValid = Int -> [Int]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Int8 where
genValid :: Gen Int8
genValid = Gen Int8
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
shrinkValid :: Int8 -> [Int8]
shrinkValid = Int8 -> [Int8]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Int16 where
genValid :: Gen Int16
genValid = Gen Int16
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
shrinkValid :: Int16 -> [Int16]
shrinkValid = Int16 -> [Int16]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Int32 where
genValid :: Gen Int32
genValid = Gen Int32
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
shrinkValid :: Int32 -> [Int32]
shrinkValid = Int32 -> [Int32]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Int64 where
genValid :: Gen Int64
genValid = Gen Int64
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
shrinkValid :: Int64 -> [Int64]
shrinkValid = Int64 -> [Int64]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Word where
genValid :: Gen Word
genValid = Gen Word
forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX
shrinkValid :: Word -> [Word]
shrinkValid = Word -> [Word]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Word8 where
genValid :: Gen Word8
genValid = Gen Word8
forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX
shrinkValid :: Word8 -> [Word8]
shrinkValid = Word8 -> [Word8]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Word16 where
genValid :: Gen Word16
genValid = Gen Word16
forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX
shrinkValid :: Word16 -> [Word16]
shrinkValid = Word16 -> [Word16]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Word32 where
genValid :: Gen Word32
genValid = Gen Word32
forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX
shrinkValid :: Word32 -> [Word32]
shrinkValid = Word32 -> [Word32]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Word64 where
genValid :: Gen Word64
genValid = Gen Word64
forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX
shrinkValid :: Word64 -> [Word64]
shrinkValid = Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Float where
genValid :: Gen Float
genValid = Gen Float
genFloat
shrinkValid :: Float -> [Float]
shrinkValid Float
f
| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
f = []
| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
f = []
| Bool
otherwise = Float -> [Float]
forall a. Arbitrary a => a -> [a]
shrink Float
f
instance GenValid Double where
genValid :: Gen Double
genValid = Gen Double
genDouble
shrinkValid :: Double -> [Double]
shrinkValid Double
d
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d = []
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d = []
| Bool
otherwise = Double -> [Double]
forall a. Arbitrary a => a -> [a]
shrink Double
d
instance GenValid Integer where
genValid :: Gen Integer
genValid = Gen Integer
genInteger
shrinkValid :: Integer -> [Integer]
shrinkValid = Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink
instance GenValid Natural where
genValid :: Gen Natural
genValid = Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> (Integer -> Integer) -> Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Natural) -> Gen Integer -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. GenValid a => Gen a
genValid
shrinkValid :: Natural -> [Natural]
shrinkValid = (Integer -> Natural) -> [Integer] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> (Integer -> Integer) -> Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
abs) ([Integer] -> [Natural])
-> (Natural -> [Integer]) -> Natural -> [Natural]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. GenValid a => a -> [a]
shrinkValid (Integer -> [Integer])
-> (Natural -> Integer) -> Natural -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
instance (Integral a, Num a, Ord a, GenValid a) => GenValid (Ratio a) where
genValid :: Gen (Ratio a)
genValid =
( do
a
n <- Gen a
forall a. GenValid a => Gen a
genValid
a
d <- (Gen a
forall a. GenValid a => Gen a
genValid Gen a -> (a -> Bool) -> Gen a
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0))
Ratio a -> Gen (Ratio a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ratio a -> Gen (Ratio a)) -> Ratio a -> Gen (Ratio a)
forall a b. (a -> b) -> a -> b
$ a
n a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
d
)
Gen (Ratio a) -> (Ratio a -> Bool) -> Gen (Ratio a)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Ratio a -> Bool
forall a. Validity a => a -> Bool
isValid
shrinkValid :: Ratio a -> [Ratio a]
shrinkValid (a
n :% a
d) = do
(a
n', a
d') <- (a, a) -> [(a, a)]
forall a. GenValid a => a -> [a]
shrinkValid (a
n, a
d)
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ a
d' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
let candidate :: Ratio a
candidate = a
n' a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
d'
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Ratio a -> Bool
forall a. Validity a => a -> Bool
isValid Ratio a
candidate
Ratio a -> [Ratio a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ratio a -> [Ratio a]) -> Ratio a -> [Ratio a]
forall a b. (a -> b) -> a -> b
$ a
n' a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
d'
instance HasResolution a => GenValid (Fixed a) where
genValid :: Gen (Fixed a)
genValid = Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed a) -> Gen Integer -> Gen (Fixed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. GenValid a => Gen a
genValid
shrinkValid :: Fixed a -> [Fixed a]
shrinkValid (MkFixed Integer
i) = Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed a) -> [Integer] -> [Fixed a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. GenValid a => a -> [a]
shrinkValid Integer
i
genValidStructurally :: (Validity a, Generic a, GGenValid (Rep a)) => Gen a
genValidStructurally :: Gen a
genValidStructurally = Gen a
forall a. (Generic a, GGenValid (Rep a)) => Gen a
genValidStructurallyWithoutExtraChecking Gen a -> (a -> Bool) -> Gen a
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` a -> Bool
forall a. Validity a => a -> Bool
isValid
genValidStructurallyWithoutExtraChecking :: (Generic a, GGenValid (Rep a)) => Gen a
= Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Gen (Rep a Any) -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Rep a Any)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid
class GGenValid f where
gGenValid :: Gen (f a)
instance GGenValid U1 where
gGenValid :: Gen (U1 a)
gGenValid = U1 a -> Gen (U1 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
instance (GGenValid a, GGenValid b) => GGenValid (a :*: b) where
gGenValid :: Gen ((:*:) a b a)
gGenValid = a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Gen (a a) -> Gen (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid Gen (b a -> (:*:) a b a) -> Gen (b a) -> Gen ((:*:) a b a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (b a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid
instance (GGenValid a, GGenValid b) => GGenValid (a :+: b) where
gGenValid :: Gen ((:+:) a b a)
gGenValid = [Gen ((:+:) a b a)] -> Gen ((:+:) a b a)
forall a. [Gen a] -> Gen a
oneof [a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Gen (a a) -> Gen ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid, b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Gen (b a) -> Gen ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (b a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid]
instance (GGenValid a) => GGenValid (M1 i c a) where
gGenValid :: Gen (M1 i c a a)
gGenValid = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> Gen (a a) -> Gen (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid
instance (GenValid a) => GGenValid (K1 i a) where
gGenValid :: Gen (K1 i a a)
gGenValid = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> Gen a -> Gen (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. GenValid a => Gen a
genValid
shrinkValidStructurally :: (Validity a, Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
shrinkValidStructurally :: a -> [a]
shrinkValidStructurally = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
forall a. Validity a => a -> Bool
isValid ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a.
(Generic a, GValidRecursivelyShrink (Rep a),
GValidSubterms (Rep a) a) =>
a -> [a]
shrinkValidStructurallyWithoutExtraFiltering
shrinkValidStructurallyWithoutExtraFiltering :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
a
x = a -> [a]
forall a. (Generic a, GValidSubterms (Rep a) a) => a -> [a]
structurallyValidSubterms a
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. (Generic a, GValidRecursivelyShrink (Rep a)) => a -> [a]
structurallyValidRecursivelyShrink a
x
structurallyValidRecursivelyShrink :: (Generic a, GValidRecursivelyShrink (Rep a)) => a -> [a]
structurallyValidRecursivelyShrink :: a -> [a]
structurallyValidRecursivelyShrink = (Rep a Any -> a) -> [Rep a Any] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to ([Rep a Any] -> [a]) -> (a -> [Rep a Any]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> [Rep a Any]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink (Rep a Any -> [Rep a Any]) -> (a -> Rep a Any) -> a -> [Rep a Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
class GValidRecursivelyShrink f where
gValidRecursivelyShrink :: f a -> [f a]
instance (GValidRecursivelyShrink f, GValidRecursivelyShrink g) => GValidRecursivelyShrink (f :*: g) where
gValidRecursivelyShrink :: (:*:) f g a -> [(:*:) f g a]
gValidRecursivelyShrink (f a
x :*: g a
y) =
(f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f a -> g a -> (:*:) f g a) -> [f a] -> [g a -> (:*:) f g a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> [f a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink f a
x [g a -> (:*:) f g a] -> [g a] -> [(:*:) f g a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a -> [g a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink g a
y)
[(:*:) f g a] -> [(:*:) f g a] -> [(:*:) f g a]
forall a. [a] -> [a] -> [a]
++ [f a
x' f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
y | f a
x' <- f a -> [f a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink f a
x]
[(:*:) f g a] -> [(:*:) f g a] -> [(:*:) f g a]
forall a. [a] -> [a] -> [a]
++ [f a
x f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
y' | g a
y' <- g a -> [g a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink g a
y]
instance (GValidRecursivelyShrink f, GValidRecursivelyShrink g) => GValidRecursivelyShrink (f :+: g) where
gValidRecursivelyShrink :: (:+:) f g a -> [(:+:) f g a]
gValidRecursivelyShrink (L1 f a
x) = (f a -> (:+:) f g a) -> [f a] -> [(:+:) f g a]
forall a b. (a -> b) -> [a] -> [b]
map f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> [f a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink f a
x)
gValidRecursivelyShrink (R1 g a
x) = (g a -> (:+:) f g a) -> [g a] -> [(:+:) f g a]
forall a b. (a -> b) -> [a] -> [b]
map g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> [g a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink g a
x)
instance GValidRecursivelyShrink f => GValidRecursivelyShrink (M1 i c f) where
gValidRecursivelyShrink :: M1 i c f a -> [M1 i c f a]
gValidRecursivelyShrink (M1 f a
x) = (f a -> M1 i c f a) -> [f a] -> [M1 i c f a]
forall a b. (a -> b) -> [a] -> [b]
map f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> [f a]
forall (f :: * -> *) a. GValidRecursivelyShrink f => f a -> [f a]
gValidRecursivelyShrink f a
x)
instance GenValid a => GValidRecursivelyShrink (K1 i a) where
gValidRecursivelyShrink :: K1 i a a -> [K1 i a a]
gValidRecursivelyShrink (K1 a
x) = (a -> K1 i a a) -> [a] -> [K1 i a a]
forall a b. (a -> b) -> [a] -> [b]
map a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid a
x)
instance GValidRecursivelyShrink U1 where
gValidRecursivelyShrink :: U1 a -> [U1 a]
gValidRecursivelyShrink U1 a
U1 = []
instance GValidRecursivelyShrink V1 where
gValidRecursivelyShrink :: V1 a -> [V1 a]
gValidRecursivelyShrink V1 a
_ = []
structurallyValidSubterms :: (Generic a, GValidSubterms (Rep a) a) => a -> [a]
structurallyValidSubterms :: a -> [a]
structurallyValidSubterms = Rep a a -> [a]
forall (f :: * -> *) a. GValidSubterms f a => f a -> [a]
gValidSubterms (Rep a a -> [a]) -> (a -> Rep a a) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a a
forall a x. Generic a => a -> Rep a x
from
class GValidSubterms f a where
gValidSubterms :: f a -> [a]
instance GValidSubterms V1 a where
gValidSubterms :: V1 a -> [a]
gValidSubterms V1 a
_ = []
instance GValidSubterms U1 a where
gValidSubterms :: U1 a -> [a]
gValidSubterms U1 a
U1 = []
instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubterms (f :*: g) a where
gValidSubterms :: (:*:) f g a -> [a]
gValidSubterms (f a
l :*: g a
r) = f a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl f a
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ g a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl g a
r
instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubterms (f :+: g) a where
gValidSubterms :: (:+:) f g a -> [a]
gValidSubterms (L1 f a
x) = f a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl f a
x
gValidSubterms (R1 g a
x) = g a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl g a
x
instance GValidSubterms f a => GValidSubterms (M1 i c f) a where
gValidSubterms :: M1 i c f a -> [a]
gValidSubterms (M1 f a
x) = f a -> [a]
forall (f :: * -> *) a. GValidSubterms f a => f a -> [a]
gValidSubterms f a
x
instance GValidSubterms (K1 i a) b where
gValidSubterms :: K1 i a b -> [b]
gValidSubterms (K1 a
_) = []
class GValidSubtermsIncl f a where
gValidSubtermsIncl :: f a -> [a]
instance GValidSubtermsIncl V1 a where
gValidSubtermsIncl :: V1 a -> [a]
gValidSubtermsIncl V1 a
_ = []
instance GValidSubtermsIncl U1 a where
gValidSubtermsIncl :: U1 a -> [a]
gValidSubtermsIncl U1 a
U1 = []
instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubtermsIncl (f :*: g) a where
gValidSubtermsIncl :: (:*:) f g a -> [a]
gValidSubtermsIncl (f a
l :*: g a
r) = f a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl f a
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ g a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl g a
r
instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubtermsIncl (f :+: g) a where
gValidSubtermsIncl :: (:+:) f g a -> [a]
gValidSubtermsIncl (L1 f a
x) = f a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl f a
x
gValidSubtermsIncl (R1 g a
x) = g a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl g a
x
instance GValidSubtermsIncl f a => GValidSubtermsIncl (M1 i c f) a where
gValidSubtermsIncl :: M1 i c f a -> [a]
gValidSubtermsIncl (M1 f a
x) = f a -> [a]
forall (f :: * -> *) a. GValidSubtermsIncl f a => f a -> [a]
gValidSubtermsIncl f a
x
instance {-# OVERLAPPING #-} GValidSubtermsIncl (K1 i a) a where
gValidSubtermsIncl :: K1 i a a -> [a]
gValidSubtermsIncl (K1 a
x) = [a
x]
instance {-# OVERLAPPING #-} GValidSubtermsIncl (K1 i a) b where
gValidSubtermsIncl :: K1 i a b -> [b]
gValidSubtermsIncl (K1 a
_) = []