{-# 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 a -> [a]
shr (MaybeT 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 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 a -> [a]
shr (InL 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 a -> [a]
shr (InR 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 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 a -> [a]
shr (Backwards 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 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 a -> [a]
shr (Reverse 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 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 a -> [a]
shr (Pure 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 a -> [a]
shr (Other 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