{-# LANGUAGE
    FlexibleContexts,
    MultiParamTypeClasses,
    ScopedTypeVariables,
    TypeFamilies,
    TypeOperators #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Representation of (higher-order) functions.

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

-- * Instances for @(:->)@

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

-- * 'Constructible' instance for @(->)@

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