{-# LANGUAGE
FlexibleContexts,
MultiParamTypeClasses,
ScopedTypeVariables,
TypeFamilies,
TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.QuickCheck.HigherOrder.Internal.Function where
import Test.Fun ((:->), applyFun, shrinkFun, cogenFun, CoArbitrary(..), Concrete(..))
import Test.QuickCheck (Arbitrary(..), Gen, choose)
import Test.QuickCheck.HigherOrder.Internal.Constructible
concrete :: (Arbitrary a, Show a) => Concrete a
concrete :: Concrete a
concrete = (a -> [a]) -> ShowsPrec a -> Concrete a
forall r. (r -> [r]) -> ShowsPrec r -> Concrete r
Concrete a -> [a]
forall a. Arbitrary a => a -> [a]
shrink ShowsPrec a
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (CoArbitrary Gen a, Arbitrary r) => Arbitrary (a :-> r) where
arbitrary :: Gen (a :-> r)
arbitrary = Co Gen a r
forall (gen :: * -> *) a r. CoArbitrary gen a => Co gen a r
coarbitrary Gen r
forall a. Arbitrary a => Gen a
arbitrary
shrink :: (a :-> r) -> [a :-> r]
shrink = (r -> [r]) -> (a :-> r) -> [a :-> r]
forall a r. (r -> [r]) -> (a :-> r) -> [a :-> r]
shrinkFun r -> [r]
forall a. Arbitrary a => a -> [a]
shrink
instance (Constructible a, CoArbitrary Gen b) => CoArbitrary Gen (a -> b) where
coarbitrary :: Co Gen (a -> b) r
coarbitrary = Concrete (Repr a)
-> Gen (Maybe (Repr a))
-> (Repr a -> a)
-> Co Gen b ((a -> b) :-> r)
-> Co Gen (a -> b) r
forall (gen :: * -> *) a0 a b r.
Monad gen =>
Concrete a0
-> gen (Maybe a0)
-> (a0 -> a)
-> Co gen b ((a -> b) :-> r)
-> Co gen (a -> b) r
cogenFun Concrete (Repr a)
forall a. (Arbitrary a, Show a) => Concrete a
concrete Gen (Maybe (Repr a))
ga Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr Co Gen b ((a -> b) :-> r)
forall (gen :: * -> *) a r. CoArbitrary gen a => Co gen a r
coarbitrary where
ga :: Gen (Maybe (Repr a))
ga = do
Int
x <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
4 :: Int)
if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
Maybe (Repr a) -> Gen (Maybe (Repr a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Repr a)
forall a. Maybe a
Nothing
else
Repr a -> Maybe (Repr a)
forall a. a -> Maybe a
Just (Repr a -> Maybe (Repr a)) -> Gen (Repr a) -> Gen (Maybe (Repr a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Repr a)
forall a. Arbitrary a => Gen a
arbitrary
instance (CoArbitrary Gen a, Constructible b) => Constructible (a -> b) where
type Repr (a -> b) = a :-> Repr b
fromRepr :: Repr (a -> b) -> a -> b
fromRepr Repr (a -> b)
h = Repr b -> b
forall a. Constructible a => Repr a -> a
fromRepr (Repr b -> b) -> (a -> Repr b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a :-> Repr b) -> a -> Repr b
forall a r. (a :-> r) -> a -> r
applyFun a :-> Repr b
Repr (a -> b)
h