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

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

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