{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.QuickCheck.Instances.NonEmpty
( Arbitrary (..),
)
where
import Data.NonEmpty
import Data.Proxy
import Test.QuickCheck hiding (getNonEmpty)
import Data.Maybe (maybeToList)
instance
( Arbitrary a,
Semigroup a,
NonEmptySingleton a,
NonEmptyFromContainer a,
Arbitrary (NonEmptySingletonElement a)
) =>
Arbitrary (NonEmpty a)
where
arbitrary :: Gen (NonEmpty a)
arbitrary =
NonEmpty a -> a -> NonEmpty a
forall a. Semigroup a => NonEmpty a -> a -> NonEmpty a
(<|)
(NonEmpty a -> a -> NonEmpty a)
-> Gen (NonEmpty a) -> Gen (a -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NonEmptySingletonElement a -> NonEmpty a)
-> Gen (NonEmptySingletonElement a) -> Gen (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy a -> NonEmptySingletonElement a -> NonEmpty a
forall a.
NonEmptySingleton a =>
Proxy a -> NonEmptySingletonElement a -> NonEmpty a
singleton (Proxy a -> NonEmptySingletonElement a -> NonEmpty a)
-> Proxy a -> NonEmptySingletonElement a -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a) Gen (NonEmptySingletonElement a)
forall a. Arbitrary a => Gen a
arbitrary
Gen (a -> NonEmpty a) -> Gen a -> Gen (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
forall a. Arbitrary a => Gen a
arbitrary
shrink :: NonEmpty a -> [NonEmpty a]
shrink NonEmpty a
xs =
[ NonEmpty a
xs''
| a
xs' <- a -> [a]
forall a. Arbitrary a => a -> [a]
shrink (a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty NonEmpty a
xs,
NonEmpty a
xs'' <- Maybe (NonEmpty a) -> [NonEmpty a]
forall a. Maybe a -> [a]
maybeToList (Maybe (NonEmpty a) -> [NonEmpty a])
-> Maybe (NonEmpty a) -> [NonEmpty a]
forall a b. (a -> b) -> a -> b
$ a -> Maybe (NonEmpty a)
forall a. NonEmptyFromContainer a => a -> Maybe (NonEmpty a)
nonEmpty a
xs'
]