{-# LANGUAGE UndecidableInstances #-}

module PropUnit
  ( DependencyType (..)
  , Gen
  , MonadTest
  , Property
  , PropertyT
  , Range
  , TestLimit
  , TestName
  , TestT
  , TestTree
  , (===)
  , (/==)
  , after
  , assert
  , forAll
  , testProp
  , testUnit
  , defaultTestLimit
  , setupTests
  , testGroup
  , testMain
  , withResource
  , GenDefault (..)
  , genDefaultTag
  , genDefaultIntegral
  , genDefaultEnum
  , genDefaultList
  , genDefaultString
  , genDefaultGeneric
  , StdTag
  )
where

import Control.Applicative ((<|>))
import Control.Monad (when)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Proxy (Proxy (..))
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Exts (IsList (..), IsString (..))
import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:*:) (..), (:+:) (..))
import GHC.TypeLits (KnownNat, Nat, natVal)
import Hedgehog
  ( DiscardLimit
  , Gen
  , MonadTest
  , Property
  , PropertyT
  , Range
  , ShrinkLimit
  , ShrinkRetries
  , TestLimit
  , TestT
  , assert
  , forAll
  , property
  , test
  , withDiscards
  , withRetries
  , withShrinks
  , withTests
  , (/==)
  , (===)
  )
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import System.Environment (lookupEnv, setEnv)
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
import Test.Tasty (DependencyType (..), TestName, TestTree, after, defaultMain, testGroup, withResource)
import Test.Tasty.Hedgehog (testProperty)

unitProperty :: TestT IO () -> Property
unitProperty :: TestT IO () -> Property
unitProperty =
  TestLimit -> Property -> Property
withTests (TestLimit
1 :: TestLimit)
    (Property -> Property)
-> (TestT IO () -> Property) -> TestT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscardLimit -> Property -> Property
withDiscards (DiscardLimit
1 :: DiscardLimit)
    (Property -> Property)
-> (TestT IO () -> Property) -> TestT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShrinkLimit -> Property -> Property
withShrinks (ShrinkLimit
0 :: ShrinkLimit)
    (Property -> Property)
-> (TestT IO () -> Property) -> TestT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShrinkRetries -> Property -> Property
withRetries (ShrinkRetries
0 :: ShrinkRetries)
    (Property -> Property)
-> (TestT IO () -> Property) -> TestT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property
    (PropertyT IO () -> Property)
-> (TestT IO () -> PropertyT IO ()) -> TestT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestT IO () -> PropertyT IO ()
forall (m :: * -> *) a. Monad m => TestT m a -> PropertyT m a
test

testUnit :: TestName -> TestT IO () -> TestTree
testUnit :: String -> TestT IO () -> TestTree
testUnit String
name = String -> Property -> TestTree
testProperty String
name (Property -> TestTree)
-> (TestT IO () -> Property) -> TestT IO () -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestT IO () -> Property
unitProperty

testProp :: TestName -> TestLimit -> PropertyT IO () -> TestTree
testProp :: String -> TestLimit -> PropertyT IO () -> TestTree
testProp String
name TestLimit
lim = String -> Property -> TestTree
testProperty String
name (Property -> TestTree)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> Property -> Property
withTests TestLimit
lim (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property

-- 100 is Hedgehog's defaultMinTests
defaultTestLimit :: TestLimit
defaultTestLimit :: TestLimit
defaultTestLimit = TestLimit
100

setupTests :: IO TestLimit
setupTests :: IO TestLimit
setupTests = do
  Maybe String
mayDebugStr <- String -> IO (Maybe String)
lookupEnv String
"PROP_UNIT_DEBUG"
  let debug :: Bool
debug = String -> Maybe String
forall a. a -> Maybe a
Just String
"1" Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
mayDebugStr
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> String -> IO ()
setEnv String
"TASTY_NUM_THREADS" String
"1"
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
  Maybe String
mayLimStr <- String -> IO (Maybe String)
lookupEnv String
"PROP_UNIT_LIMIT"
  TestLimit -> IO TestLimit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestLimit -> (String -> TestLimit) -> Maybe String -> TestLimit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TestLimit
defaultTestLimit (Integer -> TestLimit
forall a. Num a => Integer -> a
fromInteger (Integer -> TestLimit)
-> (String -> Integer) -> String -> TestLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Read a => String -> a
read) Maybe String
mayLimStr)

testMain :: (TestLimit -> TestTree) -> IO ()
testMain :: (TestLimit -> TestTree) -> IO ()
testMain TestLimit -> TestTree
f = do
  TestLimit
lim <- IO TestLimit
setupTests
  TestTree -> IO ()
defaultMain (TestLimit -> TestTree
f TestLimit
lim)

class GenDefault tag a where
  -- | Default generator for @a@
  --
  -- The type-level @tag@ allows types @a@ to have multiple defaults.
  genDefault :: Proxy tag -> Gen a

-- | DerivingVia wrapper for types with default instances under other tags
newtype ViaTag tag' a = ViaTag {forall tag' a. ViaTag tag' a -> a
unViaTag :: a}

instance (GenDefault tag' a) => GenDefault tag (ViaTag tag' a) where
  genDefault :: Proxy tag -> Gen (ViaTag tag' a)
genDefault Proxy tag
_ = (a -> ViaTag tag' a) -> GenT Identity a -> Gen (ViaTag tag' a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ViaTag tag' a
forall tag' a. a -> ViaTag tag' a
ViaTag (forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault @tag' Proxy tag'
forall {k} (t :: k). Proxy t
Proxy)

genDefaultTag :: forall tag a tag'. (GenDefault tag' a) => Proxy tag' -> Proxy tag -> Gen a
genDefaultTag :: forall tag a tag'.
GenDefault tag' a =>
Proxy tag' -> Proxy tag -> Gen a
genDefaultTag Proxy tag'
_ Proxy tag
_ = (ViaTag tag' a -> a)
-> GenT Identity (ViaTag tag' a) -> GenT Identity a
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall tag' a. ViaTag tag' a -> a
unViaTag @tag' @a) (Proxy tag -> GenT Identity (ViaTag tag' a)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @tag))

-- | DerivingVia wrapper for Integral types
newtype ViaIntegral a = ViaIntegral {forall a. ViaIntegral a -> a
unViaIntegral :: a}

instance (Integral a, Bounded a) => GenDefault tag (ViaIntegral a) where
  genDefault :: Proxy tag -> Gen (ViaIntegral a)
genDefault Proxy tag
_ = (a -> ViaIntegral a) -> GenT Identity a -> Gen (ViaIntegral a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ViaIntegral a
forall a. a -> ViaIntegral a
ViaIntegral (Range a -> GenT Identity a
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (a -> a -> a -> Range a
forall a. a -> a -> a -> Range a
Range.constantFrom a
0 a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound))

genDefaultIntegral :: forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral :: forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral Proxy tag
_ = (ViaIntegral a -> a)
-> GenT Identity (ViaIntegral a) -> GenT Identity a
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ViaIntegral a -> a
unViaIntegral @a) (Proxy tag -> GenT Identity (ViaIntegral a)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @tag))

-- | DerivingVia wrapper for Enum types
newtype ViaEnum a = ViaEnum {forall a. ViaEnum a -> a
unViaEnum :: a}

instance (Enum a, Bounded a) => GenDefault tag (ViaEnum a) where
  genDefault :: Proxy tag -> Gen (ViaEnum a)
genDefault Proxy tag
_ = (a -> ViaEnum a) -> GenT Identity a -> Gen (ViaEnum a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ViaEnum a
forall a. a -> ViaEnum a
ViaEnum GenT Identity a
forall (m :: * -> *) a. (MonadGen m, Enum a, Bounded a) => m a
Gen.enumBounded

genDefaultEnum :: forall tag a. (Enum a, Bounded a) => Proxy tag -> Gen a
genDefaultEnum :: forall tag a. (Enum a, Bounded a) => Proxy tag -> Gen a
genDefaultEnum Proxy tag
_ = (ViaEnum a -> a) -> GenT Identity (ViaEnum a) -> GenT Identity a
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ViaEnum a -> a
unViaEnum @a) (Proxy tag -> GenT Identity (ViaEnum a)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @tag))

-- | DerivingVia wrapper for FromList types
newtype ViaList a (mn :: Nat) (mx :: Nat) = ViaList {forall a (mn :: Nat) (mx :: Nat). ViaList a mn mx -> a
unViaList :: a}

instance (IsList a, GenDefault tag (Item a), KnownNat mn, KnownNat mx) => GenDefault tag (ViaList a mn mx) where
  genDefault :: Proxy tag -> Gen (ViaList a mn mx)
genDefault Proxy tag
p =
    let bn :: Int
bn = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy mn -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @mn))
        bx :: Int
bx = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy mx -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @mx))
    in  ([Item a] -> ViaList a mn mx)
-> GenT Identity [Item a] -> Gen (ViaList a mn mx)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> ViaList a mn mx
forall a (mn :: Nat) (mx :: Nat). a -> ViaList a mn mx
ViaList (a -> ViaList a mn mx)
-> ([Item a] -> a) -> [Item a] -> ViaList a mn mx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item a] -> a
forall l. IsList l => [Item l] -> l
fromList) (Range Int -> GenT Identity (Item a) -> GenT Identity [Item a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
bn Int
bx) (Proxy tag -> GenT Identity (Item a)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault Proxy tag
p))

genDefaultList
  :: forall tag a mn mx
   . (IsList a, KnownNat mn, KnownNat mx, GenDefault tag (Item a))
  => Proxy mn
  -> Proxy mx
  -> Proxy tag
  -> Gen a
genDefaultList :: forall tag a (mn :: Nat) (mx :: Nat).
(IsList a, KnownNat mn, KnownNat mx, GenDefault tag (Item a)) =>
Proxy mn -> Proxy mx -> Proxy tag -> Gen a
genDefaultList Proxy mn
_ Proxy mx
_ Proxy tag
_ = (ViaList a mn mx -> a)
-> GenT Identity (ViaList a mn mx) -> GenT Identity a
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a (mn :: Nat) (mx :: Nat). ViaList a mn mx -> a
unViaList @a @mn @mx) (Proxy tag -> GenT Identity (ViaList a mn mx)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @tag))

-- | DerivingVia wrapper for FromString types
newtype ViaString s (mn :: Nat) (mx :: Nat) = ViaString {forall s (mn :: Nat) (mx :: Nat). ViaString s mn mx -> s
unViaString :: s}

instance (IsString s, GenDefault tag Char, KnownNat mn, KnownNat mx) => GenDefault tag (ViaString s mn mx) where
  genDefault :: Proxy tag -> Gen (ViaString s mn mx)
genDefault Proxy tag
p =
    let bn :: Int
bn = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy mn -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @mn))
        bx :: Int
bx = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy mx -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @mx))
    in  (String -> ViaString s mn mx)
-> GenT Identity String -> Gen (ViaString s mn mx)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> ViaString s mn mx
forall s (mn :: Nat) (mx :: Nat). s -> ViaString s mn mx
ViaString (s -> ViaString s mn mx)
-> (String -> s) -> String -> ViaString s mn mx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString) (Range Int -> GenT Identity Char -> GenT Identity String
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
bn Int
bx) (Proxy tag -> GenT Identity Char
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault Proxy tag
p))

genDefaultString
  :: forall tag a mn mx
   . (IsString a, KnownNat mn, KnownNat mx, GenDefault tag Char)
  => Proxy mn
  -> Proxy mx
  -> Proxy tag
  -> Gen a
genDefaultString :: forall tag a (mn :: Nat) (mx :: Nat).
(IsString a, KnownNat mn, KnownNat mx, GenDefault tag Char) =>
Proxy mn -> Proxy mx -> Proxy tag -> Gen a
genDefaultString Proxy mn
_ Proxy mx
_ Proxy tag
_ = (ViaString a mn mx -> a)
-> GenT Identity (ViaString a mn mx) -> GenT Identity a
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (mn :: Nat) (mx :: Nat). ViaString s mn mx -> s
unViaString @a @mn @mx) (Proxy tag -> GenT Identity (ViaString a mn mx)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @tag))

class GGenDefault tag f where
  ggenDefault :: Proxy tag -> Gen (f a)

instance GGenDefault tag U1 where
  ggenDefault :: forall a. Proxy tag -> Gen (U1 a)
ggenDefault Proxy tag
_ = U1 a -> GenT Identity (U1 a)
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1

instance (GGenDefault tag a) => GGenDefault tag (M1 i c a) where
  ggenDefault :: forall a. Proxy tag -> Gen (M1 i c a a)
ggenDefault = (a a -> M1 i c a a)
-> GenT Identity (a a) -> GenT Identity (M1 i c a a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (GenT Identity (a a) -> GenT Identity (M1 i c a a))
-> (Proxy tag -> GenT Identity (a a))
-> Proxy tag
-> GenT Identity (M1 i c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy tag -> GenT Identity (a a)
forall a. Proxy tag -> Gen (a a)
forall tag (f :: * -> *) a.
GGenDefault tag f =>
Proxy tag -> Gen (f a)
ggenDefault

instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :*: b) where
  ggenDefault :: forall a. Proxy tag -> Gen ((:*:) a b a)
ggenDefault Proxy tag
p = (a a -> b a -> (:*:) a b a)
-> GenT Identity (a a)
-> GenT Identity (b a)
-> GenT Identity ((:*:) a b a)
forall a b c.
(a -> b -> c)
-> GenT Identity a -> GenT Identity b -> GenT Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (Proxy tag -> GenT Identity (a a)
forall a. Proxy tag -> Gen (a a)
forall tag (f :: * -> *) a.
GGenDefault tag f =>
Proxy tag -> Gen (f a)
ggenDefault Proxy tag
p) (Proxy tag -> GenT Identity (b a)
forall a. Proxy tag -> Gen (b a)
forall tag (f :: * -> *) a.
GGenDefault tag f =>
Proxy tag -> Gen (f a)
ggenDefault Proxy tag
p)

instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :+: b) where
  ggenDefault :: forall a. Proxy tag -> Gen ((:+:) a b a)
ggenDefault Proxy tag
p = (a a -> (:+:) a b a)
-> GenT Identity (a a) -> GenT Identity ((:+:) a b a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Proxy tag -> GenT Identity (a a)
forall a. Proxy tag -> Gen (a a)
forall tag (f :: * -> *) a.
GGenDefault tag f =>
Proxy tag -> Gen (f a)
ggenDefault Proxy tag
p) GenT Identity ((:+:) a b a)
-> GenT Identity ((:+:) a b a) -> GenT Identity ((:+:) a b a)
forall a. GenT Identity a -> GenT Identity a -> GenT Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b a -> (:+:) a b a)
-> GenT Identity (b a) -> GenT Identity ((:+:) a b a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Proxy tag -> GenT Identity (b a)
forall a. Proxy tag -> Gen (b a)
forall tag (f :: * -> *) a.
GGenDefault tag f =>
Proxy tag -> Gen (f a)
ggenDefault Proxy tag
p)

instance (GenDefault tag a) => GGenDefault tag (K1 i a) where
  ggenDefault :: forall a. Proxy tag -> Gen (K1 i a a)
ggenDefault = (a -> K1 i a a) -> GenT Identity a -> GenT Identity (K1 i a a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (GenT Identity a -> GenT Identity (K1 i a a))
-> (Proxy tag -> GenT Identity a)
-> Proxy tag
-> GenT Identity (K1 i a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy tag -> GenT Identity a
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault

-- | DerivingVia wrapper for Generic types
newtype ViaGeneric tag a = ViaGeneric {forall tag a. ViaGeneric tag a -> a
unViaGeneric :: a}

instance (Generic a, GGenDefault tag (Rep a)) => GenDefault tag (ViaGeneric tag a) where
  genDefault :: Proxy tag -> Gen (ViaGeneric tag a)
genDefault = (Rep a Any -> ViaGeneric tag a)
-> GenT Identity (Rep a Any) -> Gen (ViaGeneric tag a)
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> ViaGeneric tag a
forall tag a. a -> ViaGeneric tag a
ViaGeneric (a -> ViaGeneric tag a)
-> (Rep a Any -> a) -> Rep a Any -> ViaGeneric tag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to) (GenT Identity (Rep a Any) -> Gen (ViaGeneric tag a))
-> (Proxy tag -> GenT Identity (Rep a Any))
-> Proxy tag
-> Gen (ViaGeneric tag a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy tag -> GenT Identity (Rep a Any)
forall a. Proxy tag -> Gen (Rep a a)
forall tag (f :: * -> *) a.
GGenDefault tag f =>
Proxy tag -> Gen (f a)
ggenDefault

genDefaultGeneric :: forall tag a. (Generic a, GGenDefault tag (Rep a)) => Proxy tag -> Gen a
genDefaultGeneric :: forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric Proxy tag
_ = (ViaGeneric tag a -> a)
-> GenT Identity (ViaGeneric tag a) -> GenT Identity a
forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall tag a. ViaGeneric tag a -> a
unViaGeneric @tag @a) (Proxy tag -> GenT Identity (ViaGeneric tag a)
forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @tag))

-- | Type tag for these "standard" default generators.
-- You can use this tag directly or choose type-by-type with 'genDefaultTag'.
data StdTag

instance GenDefault StdTag () where genDefault :: Proxy StdTag -> Gen ()
genDefault = Proxy StdTag -> Gen ()
forall tag a. (Enum a, Bounded a) => Proxy tag -> Gen a
genDefaultEnum

instance GenDefault StdTag Bool where genDefault :: Proxy StdTag -> Gen Bool
genDefault = Proxy StdTag -> Gen Bool
forall tag a. (Enum a, Bounded a) => Proxy tag -> Gen a
genDefaultEnum

instance GenDefault StdTag Char where genDefault :: Proxy StdTag -> GenT Identity Char
genDefault = Proxy StdTag -> GenT Identity Char
forall tag a. (Enum a, Bounded a) => Proxy tag -> Gen a
genDefaultEnum

instance GenDefault StdTag Int where genDefault :: Proxy StdTag -> Gen Int
genDefault = Proxy StdTag -> Gen Int
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Int8 where genDefault :: Proxy StdTag -> Gen Int8
genDefault = Proxy StdTag -> Gen Int8
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Int16 where genDefault :: Proxy StdTag -> Gen Int16
genDefault = Proxy StdTag -> Gen Int16
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Int32 where genDefault :: Proxy StdTag -> Gen Int32
genDefault = Proxy StdTag -> Gen Int32
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Int64 where genDefault :: Proxy StdTag -> Gen Int64
genDefault = Proxy StdTag -> Gen Int64
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Word where genDefault :: Proxy StdTag -> Gen Word
genDefault = Proxy StdTag -> Gen Word
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Word8 where genDefault :: Proxy StdTag -> Gen Word8
genDefault = Proxy StdTag -> Gen Word8
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Word16 where genDefault :: Proxy StdTag -> Gen Word16
genDefault = Proxy StdTag -> Gen Word16
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Word32 where genDefault :: Proxy StdTag -> Gen Word32
genDefault = Proxy StdTag -> Gen Word32
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance GenDefault StdTag Word64 where genDefault :: Proxy StdTag -> Gen Word64
genDefault = Proxy StdTag -> Gen Word64
forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a
genDefaultIntegral

instance (GenDefault StdTag a) => GenDefault StdTag (Maybe a) where genDefault :: Proxy StdTag -> Gen (Maybe a)
genDefault = Proxy StdTag -> Gen (Maybe a)
forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric

instance (GenDefault StdTag a, GenDefault StdTag b) => GenDefault StdTag (Either a b) where
  genDefault :: Proxy StdTag -> Gen (Either a b)
genDefault = Proxy StdTag -> Gen (Either a b)
forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric

instance (GenDefault StdTag a, GenDefault StdTag b) => GenDefault StdTag (a, b) where genDefault :: Proxy StdTag -> Gen (a, b)
genDefault = Proxy StdTag -> Gen (a, b)
forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric

instance (GenDefault StdTag a, GenDefault StdTag b, GenDefault StdTag c) => GenDefault StdTag (a, b, c) where
  genDefault :: Proxy StdTag -> Gen (a, b, c)
genDefault = Proxy StdTag -> Gen (a, b, c)
forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric

instance (GenDefault StdTag a, GenDefault StdTag b, GenDefault StdTag c, GenDefault StdTag d) => GenDefault StdTag (a, b, c, d) where
  genDefault :: Proxy StdTag -> Gen (a, b, c, d)
genDefault = Proxy StdTag -> Gen (a, b, c, d)
forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric

instance
  (GenDefault StdTag a, GenDefault StdTag b, GenDefault StdTag c, GenDefault StdTag d, GenDefault StdTag e)
  => GenDefault StdTag (a, b, c, d, e)
  where
  genDefault :: Proxy StdTag -> Gen (a, b, c, d, e)
genDefault = Proxy StdTag -> Gen (a, b, c, d, e)
forall tag a.
(Generic a, GGenDefault tag (Rep a)) =>
Proxy tag -> Gen a
genDefaultGeneric