{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module        : Test.QuickCheck.Instances.NonEmpty
-- Copyright     : Gautier DI FOLCO
-- License       : BSD2
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Unstable
-- Portability   : GHC
--
-- QuickCheck's 'Arbitrary' instance for 'NonEmpty'.
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'
    ]