{-# 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 shrink showsPrec
instance (CoArbitrary Gen a, Arbitrary r) => Arbitrary (a :-> r) where
arbitrary = coarbitrary arbitrary
shrink = shrinkFun shrink
instance (Constructible a, CoArbitrary Gen b) => CoArbitrary Gen (a -> b) where
coarbitrary = cogenFun concrete ga fromRepr coarbitrary where
ga = do
x <- choose (0, 4 :: Int)
if x == 0 then
pure Nothing
else
Just <$> arbitrary
instance (CoArbitrary Gen a, Constructible b) => Constructible (a -> b) where
type Repr (a -> b) = a :-> Repr b
fromRepr h = fromRepr . applyFun h