{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- |
--
--    @GenValid@ exists to make tests involving @Validity@ types easier and
--    speed up the generation of data for them.
--
--    To implement tests for this datatype, we would have to be able to
--    generate both primes. We could do this with a generator like this one:
--
--    > (Prime <$> 'arbitrary') `suchThat` isValid
--
--    However, this is tedious and inefficient, as well as quite
--    naive (because 'arbitrary' tends to use very naive generators).
--
--    The @GenValid@ type class allows you to specify how to (efficiently)
--    generate valid data of the given type to allow for easier and quicker testing.
--    The default implementation of `GenValid` already gives you a generator and shrinking function
--    for free:
--
--    > instance GenValid Prime
--
--    For example, to generate primes, we don't have to consider even numbers other
--    than 2. A more efficient implementation could then look as follows:
--
--    > instance GenValid Prime where
--    >     genValid = Prime <$>
--    >        (oneof
--    >          [ pure 2
--    >          , ((\y -> 2 * abs y + 1) <$> arbitrary) `suchThat` isPrime)
--    >          ])
--
--
--    Typical examples of tests involving validity could look as follows:
--
--    > it "succeeds when given valid input" $ do
--    >     forAllValid $ \input ->
--    >         myFunction input `shouldSatisfy` isRight
--
--    > it "produces valid output when it succeeds" $ do
--    >     forAllValid $ \input ->
--    >         case myFunction input of
--    >             Nothing -> return () -- Can happen
--    >             Just output -> output `shouldSatisfy` isValid
--
--    Definitely also look at the companion packages for more info on how to use this package.
module Data.GenValidity
  ( GenValid (..),

    -- * Helper functions
    genValidStructurally,
    genValidStructurallyWithoutExtraChecking,
    shrinkValidStructurally,
    shrinkValidStructurallyWithoutExtraFiltering,
    module Data.GenValidity.Utils,

    -- ** Helper functions for specific types

    -- *** Char
    genUtf16SurrogateCodePoint,
    genLineSeparator,
    genNonLineSeparator,

    -- *** String
    genSingleLineString,

    -- * Re-exports
    module Data.Validity,

    -- * The Generics magic
    GGenValid (..),
    GValidRecursivelyShrink (..),
    structurallyValidSubterms,
    GValidSubterms (..),
    GValidSubtermsIncl (..),
  )
where

import Control.Monad (guard)
import Data.Char (chr)
import Data.Fixed (Fixed (..), HasResolution)
import Data.Functor.Const (Const (Const))
import Data.Functor.Identity (Identity (Identity))
import Data.GenValidity.Utils
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List.NonEmpty (NonEmpty)
import Data.Monoid (Alt, Dual)
import qualified Data.Monoid as Monoid
import Data.Ratio ((%))
import qualified Data.Semigroup as Semigroup
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" #-}

-- | A class of types for which valid values can be generated to be valid.
--
-- === How to instantiate 'GenValid'
--
-- __Step 1__: Try to instantiate 'GenValid' without overriding any functions.
--             It is possible that, if few values are valid or if validity
--             checking is expensive, the resulting generator is too slow.
--             In that case, go to Step 2.
--
-- __Step 2__: Consider using 'genValidStructurallyWithoutExtraChecking' and
--             'shrinkValidStructurallyWithoutExtraFiltering' to speed up generation.
--             This only works if your type has a derived or trivial 'Validity'
--             instance.
--
-- __Step 3__: If that still is not fast enough, consider writing your own
--             generator and shrinking function.
--             Make sure to generate any possible valid value, but only valid values.
--
-- === A note about 'Arbitrary'
--
-- If you also write @Arbitrary@ instances for @GenValid@ types, it may be
-- best to simply use
--
-- > instance Arbitrary A where
-- >   arbitrary = genValid
-- >   shrink = shrinkValid
class (Validity a) => GenValid a where
  -- | Generate a valid datum, this should cover all possible valid values in
  -- the type
  --
  -- The default implementation is as follows:
  --
  -- >  genValid = genValidStructurally
  --
  -- To speed up testing, it may be a good idea to implement this yourself.
  -- If you do, make sure that it is possible to generate all possible valid
  -- data, otherwise your testing may not cover all cases.
  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

  -- | Shrink a valid value.
  --
  -- The default implementation is as follows:
  --
  -- >  shrinkValid = shrinkValidStructurally
  --
  -- It is important that this shrinking function only shrinks values to valid values.
  -- If `shrinkValid` ever shrinks a value to an invalid value, the test that is being shrunk for
  -- might fail for a different reason than for the reason that it originally failed.
  -- This would lead to very confusing error messages.
  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. HasCallStack => 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. HasCallStack => Int -> Gen a -> Gen a
resize Int
s Gen b
forall a. GenValid a => Gen a
genValid
      (a, b) -> Gen (a, b)
forall a. a -> Gen a
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. HasCallStack => [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. HasCallStack => 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. HasCallStack => 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. HasCallStack => 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 a. a -> Gen a
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, b, c) -> [(a, b, c)]
forall a b c.
(a -> [a]) -> (b -> [b]) -> (c -> [c]) -> (a, b, c) -> [(a, b, c)]
shrinkTriple a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid b -> [b]
forall a. GenValid a => a -> [a]
shrinkValid c -> [c]
forall a. GenValid a => a -> [a]
shrinkValid

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. HasCallStack => 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. HasCallStack => 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. HasCallStack => 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. HasCallStack => 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 a. a -> Gen a
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, b, c, d)
-> [(a, b, c, d)]
forall a b c d.
(a -> [a])
-> (b -> [b])
-> (c -> [c])
-> (d -> [d])
-> (a, b, c, d)
-> [(a, b, c, d)]
shrinkQuadruple a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid b -> [b]
forall a. GenValid a => a -> [a]
shrinkValid c -> [c]
forall a. GenValid a => a -> [a]
shrinkValid d -> [d]
forall a. GenValid a => a -> [a]
shrinkValid

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. HasCallStack => 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. HasCallStack => 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. HasCallStack => 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. HasCallStack => 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. HasCallStack => 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 a. a -> Gen a
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 a -> Gen (Maybe a)
forall a. Gen a -> Gen (Maybe a)
genMaybe Gen a
forall a. GenValid a => Gen a
genValid
  shrinkValid :: Maybe a -> [Maybe a]
shrinkValid = (a -> [a]) -> Maybe a -> [Maybe a]
forall a. (a -> [a]) -> Maybe a -> [Maybe a]
shrinkMaybe a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

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 -> [a]) -> NonEmpty a -> [NonEmpty a]
forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkNonEmpty a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

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 a. a -> Gen a
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. HasCallStack => [(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. HasCallStack => [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. HasCallStack => [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 a b. (a -> b) -> [a] -> [b]
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 a. a -> Gen 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]) -> (a, a) -> [(a, a)]
forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid) (a
n, a
d)
    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 a. a -> [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

-- | Generate a valid value by generating all the sub parts using the 'Generic' instance,
-- and trying that until a valid value has been generated
--
-- > genValidStructurally = genValidStructurallyWithoutExtraChecking `suchThat` isValid
--
-- This is probably the function that you are looking for.
-- If you do use this function to override `genValid`, you probably also want to use
-- 'shrinkValidStructurally' to override 'shrinkValid'.
genValidStructurally :: (Validity a, Generic a, GGenValid (Rep a)) => Gen a
genValidStructurally :: forall a. (Validity a, Generic a, GGenValid (Rep a)) => 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

-- | Generate a valid value by generating all the sub parts using the 'Generic' instance,
--
-- This generator is _not_ guaranteed to generate a valid value.
--
-- This is probably _not_ the function that you are looking for when overriding
-- `genValid` _unless_ the type in question has no _extra_ validity constraints on top of
-- the validity of its sub parts.
genValidStructurallyWithoutExtraChecking :: (Generic a, GGenValid (Rep a)) => Gen a
genValidStructurallyWithoutExtraChecking :: forall a. (Generic a, GGenValid (Rep a)) => Gen a
genValidStructurallyWithoutExtraChecking = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. 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 a. Gen (Rep a a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid

class GGenValid f where
  gGenValid :: Gen (f a)

instance GGenValid U1 where
  gGenValid :: forall a. Gen (U1 a)
gGenValid = U1 a -> Gen (U1 a)
forall a. a -> Gen 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 :: forall a. 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 a. 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 a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (b a)
forall a. Gen (b a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid

instance (GGenValid a, GGenValid b) => GGenValid (a :+: b) where
  gGenValid :: forall a. Gen ((:+:) a b a)
gGenValid = [Gen ((:+:) a b a)] -> Gen ((:+:) a b a)
forall a. HasCallStack => [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 a. 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 a. Gen (b a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid]

instance (GGenValid a) => GGenValid (M1 i c a) where
  gGenValid :: forall a. 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 a. Gen (a a)
forall (f :: * -> *) a. GGenValid f => Gen (f a)
gGenValid

instance (GenValid a) => GGenValid (K1 i a) where
  gGenValid :: forall a. 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

deriving newtype instance (GenValid a) => GenValid (Identity a)

deriving newtype instance (GenValid (f a)) => GenValid (Alt f a)

deriving newtype instance (GenValid a) => GenValid (Dual a)

deriving newtype instance (GenValid a) => GenValid (Semigroup.First a)

deriving newtype instance (GenValid a) => GenValid (Semigroup.Last a)

deriving newtype instance (GenValid a) => GenValid (Monoid.First a)

deriving newtype instance (GenValid a) => GenValid (Monoid.Last a)

deriving newtype instance (GenValid a) => GenValid (Const a b)

-- | Shrink a term to any of its immediate valid subterms,
-- and also recursively shrink all subterms, and then filtering out the results that are not valid.
--
-- > shrinkValidStructurally = filter isValid . shrinkValidStructurallyWithoutExtraFiltering
--
-- This is probably the function that you are looking for.
shrinkValidStructurally :: (Validity a, Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
shrinkValidStructurally :: forall a.
(Validity a, Generic a, GValidRecursivelyShrink (Rep a),
 GValidSubterms (Rep a) a) =>
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

-- | Shrink a term to any of its immediate valid subterms,
-- and also recursively shrink all subterms.
--
-- This shrinking function is _not_ guaranteed to shrink to valid values.
--
-- This is probably _not_ the function that you are looking for when overriding
-- `shrinkValid` _unless_ the type in question has no _extra_ validity constraints on top of
-- the validity of its sub parts.
shrinkValidStructurallyWithoutExtraFiltering :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
shrinkValidStructurallyWithoutExtraFiltering :: forall a.
(Generic a, GValidRecursivelyShrink (Rep a),
 GValidSubterms (Rep a) a) =>
a -> [a]
shrinkValidStructurallyWithoutExtraFiltering 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

-- | Recursively shrink all immediate structurally valid subterms.
structurallyValidRecursivelyShrink :: (Generic a, GValidRecursivelyShrink (Rep a)) => a -> [a]
structurallyValidRecursivelyShrink :: forall a. (Generic a, GValidRecursivelyShrink (Rep a)) => 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
forall x. 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 a. Rep a a -> [Rep a a]
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 x. a -> Rep a x
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 :: forall a. (:*:) 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 a. 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 a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a -> [g a]
forall a. 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 a. 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 a. 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 :: forall a. (:+:) 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 a. 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 a. 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 :: forall a. 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 a. 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 :: forall a. 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 :: forall a. U1 a -> [U1 a]
gValidRecursivelyShrink U1 a
U1 = []

instance GValidRecursivelyShrink V1 where
  -- The empty type can't be shrunk to anything.
  gValidRecursivelyShrink :: forall a. V1 a -> [V1 a]
gValidRecursivelyShrink V1 a
_ = []

-- | All immediate validSubterms of a term.
structurallyValidSubterms :: (Generic a, GValidSubterms (Rep a) a) => a -> [a]
structurallyValidSubterms :: forall a. (Generic a, GValidSubterms (Rep a) a) => 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 x. a -> Rep a x
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

-- This is the important case: We've found a term of the same type.
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
_) = []