{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.QuickCheck.Instances.Transformer () where

import Prelude ()
import Test.QuickCheck.Instances.CustomPrelude

import Control.Applicative.Backwards (Backwards (..))
import Control.Applicative.Lift      (Lift (..))
import Data.Functor.Reverse          (Reverse (..))

import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Functor.Sum          (Sum (..))

import Test.QuickCheck

-------------------------------------------------------------------------------
-- transformers
-------------------------------------------------------------------------------

-- TODO: CoArbitrary and Function, needs Coarbitrary1 and Function1

instance (Arbitrary1 m) => Arbitrary1 (MaybeT m) where
  liftArbitrary :: Gen a -> Gen (MaybeT m a)
liftArbitrary = (m (Maybe a) -> MaybeT m a)
-> Gen (m (Maybe a)) -> Gen (MaybeT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Gen (m (Maybe a)) -> Gen (MaybeT m a))
-> (Gen a -> Gen (m (Maybe a))) -> Gen a -> Gen (MaybeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (Maybe a) -> Gen (m (Maybe a))
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen (Maybe a) -> Gen (m (Maybe a)))
-> (Gen a -> Gen (Maybe a)) -> Gen a -> Gen (m (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen a -> Gen (Maybe a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary
  liftShrink :: (a -> [a]) -> MaybeT m a -> [MaybeT m a]
liftShrink shr :: a -> [a]
shr (MaybeT m :: m (Maybe a)
m) = (m (Maybe a) -> MaybeT m a) -> [m (Maybe a)] -> [MaybeT m a]
forall a b. (a -> b) -> [a] -> [b]
map m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((Maybe a -> [Maybe a]) -> m (Maybe a) -> [m (Maybe a)]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink ((a -> [a]) -> Maybe a -> [Maybe a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr) m (Maybe a)
m)

instance (Arbitrary1 m, Arbitrary a) => Arbitrary (MaybeT m a) where
  arbitrary :: Gen (MaybeT m a)
arbitrary = Gen (MaybeT m a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: MaybeT m a -> [MaybeT m a]
shrink = MaybeT m a -> [MaybeT m a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (Sum f g) where
  liftArbitrary :: Gen a -> Gen (Sum f g a)
liftArbitrary arb :: Gen a
arb = [Gen (Sum f g a)] -> Gen (Sum f g a)
forall a. [Gen a] -> Gen a
oneof [(f a -> Sum f g a) -> Gen (f a) -> Gen (Sum f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (Gen a -> Gen (f a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb), (g a -> Sum f g a) -> Gen (g a) -> Gen (Sum f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (Gen a -> Gen (g a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)]
  liftShrink :: (a -> [a]) -> Sum f g a -> [Sum f g a]
liftShrink shr :: a -> [a]
shr (InL f :: f a
f) = (f a -> Sum f g a) -> [f a] -> [Sum f g a]
forall a b. (a -> b) -> [a] -> [b]
map f a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL ((a -> [a]) -> f a -> [f a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr f a
f)
  liftShrink shr :: a -> [a]
shr (InR g :: g a
g) = (g a -> Sum f g a) -> [g a] -> [Sum f g a]
forall a b. (a -> b) -> [a] -> [b]
map g a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR ((a -> [a]) -> g a -> [g a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr g a
g)

instance (Arbitrary1 f, Arbitrary1 g, Arbitrary a) => Arbitrary (Sum f g a) where
  arbitrary :: Gen (Sum f g a)
arbitrary = Gen (Sum f g a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Sum f g a -> [Sum f g a]
shrink = Sum f g a -> [Sum f g a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance Arbitrary1 f => Arbitrary1 (Backwards f) where
  liftArbitrary :: Gen a -> Gen (Backwards f a)
liftArbitrary arb :: Gen a
arb = (f a -> Backwards f a) -> Gen (f a) -> Gen (Backwards f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Backwards f a
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (Gen a -> Gen (f a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)
  liftShrink :: (a -> [a]) -> Backwards f a -> [Backwards f a]
liftShrink shr :: a -> [a]
shr (Backwards xs :: f a
xs) = (f a -> Backwards f a) -> [f a] -> [Backwards f a]
forall a b. (a -> b) -> [a] -> [b]
map f a -> Backwards f a
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards ((a -> [a]) -> f a -> [f a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr f a
xs)

instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Backwards f a) where
  arbitrary :: Gen (Backwards f a)
arbitrary = Gen (Backwards f a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Backwards f a -> [Backwards f a]
shrink = Backwards f a -> [Backwards f a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance Arbitrary1 f => Arbitrary1 (Reverse f) where
  liftArbitrary :: Gen a -> Gen (Reverse f a)
liftArbitrary arb :: Gen a
arb = (f a -> Reverse f a) -> Gen (f a) -> Gen (Reverse f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (Gen a -> Gen (f a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)
  liftShrink :: (a -> [a]) -> Reverse f a -> [Reverse f a]
liftShrink shr :: a -> [a]
shr (Reverse xs :: f a
xs) = (f a -> Reverse f a) -> [f a] -> [Reverse f a]
forall a b. (a -> b) -> [a] -> [b]
map f a -> Reverse f a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse ((a -> [a]) -> f a -> [f a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr f a
xs)

instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Reverse f a) where
  arbitrary :: Gen (Reverse f a)
arbitrary = Gen (Reverse f a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Reverse f a -> [Reverse f a]
shrink = Reverse f a -> [Reverse f a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance Arbitrary1 f => Arbitrary1 (Lift f) where
  liftArbitrary :: Gen a -> Gen (Lift f a)
liftArbitrary arb :: Gen a
arb = [Gen (Lift f a)] -> Gen (Lift f a)
forall a. [Gen a] -> Gen a
oneof
    [ (a -> Lift f a) -> Gen a -> Gen (Lift f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Lift f a
forall (f :: * -> *) a. a -> Lift f a
Pure Gen a
arb
    , (f a -> Lift f a) -> Gen (f a) -> Gen (Lift f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Lift f a
forall (f :: * -> *) a. f a -> Lift f a
Other (Gen a -> Gen (f a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)
    ]

  liftShrink :: (a -> [a]) -> Lift f a -> [Lift f a]
liftShrink shr :: a -> [a]
shr (Pure x :: a
x)   = (a -> Lift f a) -> [a] -> [Lift f a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Lift f a
forall (f :: * -> *) a. a -> Lift f a
Pure (a -> [a]
shr a
x)
  liftShrink shr :: a -> [a]
shr (Other xs :: f a
xs) = (f a -> Lift f a) -> [f a] -> [Lift f a]
forall a b. (a -> b) -> [a] -> [b]
map f a -> Lift f a
forall (f :: * -> *) a. f a -> Lift f a
Other ((a -> [a]) -> f a -> [f a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr f a
xs)

instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Lift f a) where
  arbitrary :: Gen (Lift f a)
arbitrary = Gen (Lift f a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Lift f a -> [Lift f a]
shrink = Lift f a -> [Lift f a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1