{-# 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 :: forall a. Gen a -> Gen (MaybeT m a)
liftArbitrary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary
  liftShrink :: forall a. (a -> [a]) -> MaybeT m a -> [MaybeT m a]
liftShrink a -> [a]
shr (MaybeT m (Maybe a)
m) = forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink (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 = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: MaybeT m a -> [MaybeT m a]
shrink = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (Sum f g) where
  liftArbitrary :: forall a. Gen a -> Gen (Sum f g a)
liftArbitrary Gen a
arb = forall a. [Gen a] -> Gen a
oneof [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb), forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)]
  liftShrink :: forall a. (a -> [a]) -> Sum f g a -> [Sum f g a]
liftShrink a -> [a]
shr (InL f a
f) = forall a b. (a -> b) -> [a] -> [b]
map forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (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) = forall a b. (a -> b) -> [a] -> [b]
map forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (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 = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Sum f g a -> [Sum f g a]
shrink = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance Arbitrary1 f => Arbitrary1 (Backwards f) where
  liftArbitrary :: forall a. Gen a -> Gen (Backwards f a)
liftArbitrary Gen a
arb = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)
  liftShrink :: forall a. (a -> [a]) -> Backwards f a -> [Backwards f a]
liftShrink a -> [a]
shr (Backwards f a
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (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 = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Backwards f a -> [Backwards f a]
shrink = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance Arbitrary1 f => Arbitrary1 (Reverse f) where
  liftArbitrary :: forall a. Gen a -> Gen (Reverse f a)
liftArbitrary Gen a
arb = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
arb)
  liftShrink :: forall a. (a -> [a]) -> Reverse f a -> [Reverse f a]
liftShrink a -> [a]
shr (Reverse f a
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (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 = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Reverse f a -> [Reverse f a]
shrink = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

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

  liftShrink :: forall a. (a -> [a]) -> Lift f a -> [Lift f a]
liftShrink a -> [a]
shr (Pure a
x)   = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. a -> Lift f a
Pure (a -> [a]
shr a
x)
  liftShrink a -> [a]
shr (Other f a
xs) = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. f a -> Lift f a
Other (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 = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
  shrink :: Lift f a -> [Lift f a]
shrink = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1