{-# LANGUAGE TypeOperators, GADTs, CPP, Rank2Types #-}
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Safe #-}
#endif
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
#endif

#ifndef NO_GENERICS
{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}
#endif

#ifndef NO_POLYKINDS
{-# LANGUAGE PolyKinds #-}
#endif

-- | Generation of random shrinkable, showable functions.
-- See the paper \"Shrinking and showing functions\" by Koen Claessen.
--
-- __Note__: most of the contents of this module are re-exported by
-- "Test.QuickCheck". You probably do not need to import it directly.
--
-- Example of use:
--
-- >>> :{
-- >>> let prop :: Fun String Integer -> Bool
-- >>>     prop (Fun _ f) = f "monkey" == f "banana" || f "banana" == f "elephant"
-- >>> :}
-- >>> quickCheck prop
-- *** Failed! Falsified (after 3 tests and 134 shrinks):
-- {"elephant"->1, "monkey"->1, _->0}
--
-- To generate random values of type @'Fun' a b@,
-- you must have an instance @'Function' a@.
-- If your type has a 'Show' instance, you can use 'functionShow' to write the instance; otherwise,
-- use 'functionMap' to give a bijection between your type and a type that is already an instance of 'Function'.
-- See the @'Function' [a]@ instance for an example of the latter.
module Test.QuickCheck.Function
  ( Fun(..)
  , applyFun
  , apply
  , applyFun2
  , applyFun3
  , (:->)
  , Function(..)
  , functionMap
  , functionShow
  , functionIntegral
  , functionRealFrac
  , functionBoundedEnum
  , functionElements
  , functionVoid
  , functionMapWith
  , functionEitherWith
  , functionPairWith
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
  , pattern Fn
  , pattern Fn2
  , pattern Fn3
#endif
  )
 where

--------------------------------------------------------------------------
-- imports

import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Poly

import Control.Applicative
import Data.Char
import Data.Word
import Data.List( intersperse )
import Data.Ratio
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Sequence as Sequence
import qualified Data.Tree as Tree
import Data.Int
import Data.Complex
import Data.Foldable(toList)
import Data.Functor.Identity
import qualified Data.Monoid as Monoid

#if defined(MIN_VERSION_base)
#if MIN_VERSION_base(4,2,0)
import System.IO
  ( Newline(..)
  , NewlineMode(..)
  )
#endif
#endif

#ifndef NO_FIXED
import Data.Fixed
#endif

#ifndef NO_GENERICS
import GHC.Generics hiding (C)
#endif

--------------------------------------------------------------------------
-- concrete functions

-- | The type of possibly partial concrete functions
data a :-> c where
  Pair  :: (a :-> (b :-> c)) -> ((a,b) :-> c)
  (:+:) :: (a :-> c) -> (b :-> c) -> (Either a b :-> c)
  Unit  :: c -> (() :-> c)
  Nil   :: a :-> c
  Table :: Eq a => [(a,c)] -> (a :-> c)
  Map   :: (a -> b) -> (b -> a) -> (b :-> c) -> (a :-> c)

instance Functor ((:->) a) where
  fmap :: forall a b. (a -> b) -> (a :-> a) -> a :-> b
fmap a -> b
f (Pair a :-> (b :-> a)
p)    = forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
Pair (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) a :-> (b :-> a)
p)
  fmap a -> b
f (a :-> a
p:+:b :-> a
q)     = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a :-> a
p forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
:+: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f b :-> a
q
  fmap a -> b
f (Unit a
c)    = forall c. c -> () :-> c
Unit (a -> b
f a
c)
  fmap a -> b
f a :-> a
Nil         = forall a c. a :-> c
Nil
  fmap a -> b
f (Table [(a, a)]
xys) = forall a c. Eq a => [(a, c)] -> a :-> c
Table [ (a
x,a -> b
f a
y) | (a
x,a
y) <- [(a, a)]
xys ]
  fmap a -> b
f (Map a -> b
g b -> a
h b :-> a
p) = forall a b c. (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
Map a -> b
g b -> a
h (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f b :-> a
p)

instance (Show a, Show b) => Show (a:->b) where
  show :: (a :-> b) -> String
show a :-> b
p = forall a b. (Show a, Show b) => (a :-> b) -> Maybe b -> String
showFunction a :-> b
p forall a. Maybe a
Nothing

-- only use this on finite functions
showFunction :: (Show a, Show b) => (a :-> b) -> Maybe b -> String
showFunction :: forall a b. (Show a, Show b) => (a :-> b) -> Maybe b -> String
showFunction a :-> b
p Maybe b
md =
  String
"{" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
", " ( [ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
c
                                    | (a
x,b
c) <- forall a c. (a :-> c) -> [(a, c)]
table a :-> b
p
                                    ]
                                 forall a. [a] -> [a] -> [a]
++ [ String
"_->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
d
                                    | Just b
d <- [Maybe b
md]
                                    ] )) forall a. [a] -> [a] -> [a]
++ String
"}"

-- turning a concrete function into an abstract function (with a default result)
abstract :: (a :-> c) -> c -> (a -> c)
abstract :: forall a c. (a :-> c) -> c -> a -> c
abstract (Pair a :-> (b :-> c)
p)    c
d (a
x,b
y) = forall a c. (a :-> c) -> c -> a -> c
abstract (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b :-> c
q -> forall a c. (a :-> c) -> c -> a -> c
abstract b :-> c
q c
d b
y) a :-> (b :-> c)
p) c
d a
x
abstract (a :-> c
p :+: b :-> c
q)   c
d a
exy   = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a c. (a :-> c) -> c -> a -> c
abstract a :-> c
p c
d) (forall a c. (a :-> c) -> c -> a -> c
abstract b :-> c
q c
d) a
exy
abstract (Unit c
c)    c
_ a
_     = c
c
abstract a :-> c
Nil         c
d a
_     = c
d
abstract (Table [(a, c)]
xys) c
d a
x     = forall a. [a] -> a
head ([c
y | (a
x',c
y) <- [(a, c)]
xys, a
x forall a. Eq a => a -> a -> Bool
== a
x'] forall a. [a] -> [a] -> [a]
++ [c
d])
abstract (Map a -> b
g b -> a
_ b :-> c
p) c
d a
x     = forall a c. (a :-> c) -> c -> a -> c
abstract b :-> c
p c
d (a -> b
g a
x)

-- generating a table from a concrete function
table :: (a :-> c) -> [(a,c)]
table :: forall a c. (a :-> c) -> [(a, c)]
table (Pair a :-> (b :-> c)
p)    = [ ((a
x,b
y),c
c) | (a
x,b :-> c
q) <- forall a c. (a :-> c) -> [(a, c)]
table a :-> (b :-> c)
p, (b
y,c
c) <- forall a c. (a :-> c) -> [(a, c)]
table b :-> c
q ]
table (a :-> c
p :+: b :-> c
q)   = [ (forall a b. a -> Either a b
Left a
x, c
c) | (a
x,c
c) <- forall a c. (a :-> c) -> [(a, c)]
table a :-> c
p ]
                 forall a. [a] -> [a] -> [a]
++ [ (forall a b. b -> Either a b
Right b
y,c
c) | (b
y,c
c) <- forall a c. (a :-> c) -> [(a, c)]
table b :-> c
q ]
table (Unit c
c)    = [ ((), c
c) ]
table a :-> c
Nil         = []
table (Table [(a, c)]
xys) = [(a, c)]
xys
table (Map a -> b
_ b -> a
h b :-> c
p) = [ (b -> a
h b
x, c
c) | (b
x,c
c) <- forall a c. (a :-> c) -> [(a, c)]
table b :-> c
p ]

--------------------------------------------------------------------------
-- Function

-- | The class @Function a@ is used for random generation of showable
-- functions of type @a -> b@.
--
-- There is a default implementation for 'function', which you can use
-- if your type has structural equality. Otherwise, you can normally
-- use 'functionMap' or 'functionShow'.
class Function a where
  function :: (a->b) -> (a:->b)
#ifndef NO_GENERICS
  default function :: (Generic a, GFunction (Rep a)) => (a->b) -> (a:->b)
  function = forall a b. (Generic a, GFunction (Rep a)) => (a -> b) -> a :-> b
genericFunction
#endif

-- basic instances

-- | Provides a 'Function' instance for types with 'Bounded' and 'Enum'.
-- Use only for small types (i.e. not integers): creates
-- the list @['minBound'..'maxBound']@!
functionBoundedEnum :: (Eq a, Bounded a, Enum a) => (a->b) -> (a:->b)
functionBoundedEnum :: forall a b. (Eq a, Bounded a, Enum a) => (a -> b) -> a :-> b
functionBoundedEnum = forall a b. Eq a => [a] -> (a -> b) -> a :-> b
functionElements [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]

-- | Provides a 'Function' instance for small finite types.
functionElements :: Eq a => [a] ->  (a->b) -> (a:->b)
functionElements :: forall a b. Eq a => [a] -> (a -> b) -> a :-> b
functionElements [a]
xs a -> b
f = forall a c. Eq a => [(a, c)] -> a :-> c
Table [(a
x,a -> b
f a
x) | a
x <- [a]
xs]

-- | Provides a 'Function' instance for types with 'RealFrac'.
functionRealFrac :: RealFrac a => (a->b) -> (a:->b)
functionRealFrac :: forall a b. RealFrac a => (a -> b) -> a :-> b
functionRealFrac = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Real a => a -> Rational
toRational forall a. Fractional a => Rational -> a
fromRational

-- | Provides a 'Function' instance for types with 'Integral'.
functionIntegral :: Integral a => (a->b) -> (a:->b)
functionIntegral :: forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a. Num a => Integer -> a
fromInteger

-- | Provides a 'Function' instance for types with 'Show' and 'Read'.
functionShow :: (Show a, Read a) => (a->c) -> (a:->c)
functionShow :: forall a c. (Show a, Read a) => (a -> c) -> a :-> c
functionShow a -> c
f = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Show a => a -> String
show forall a. Read a => String -> a
read a -> c
f

-- | Provides a 'Function' instance for types isomorphic to 'Data.Void.Void'.
--
-- An actual @'Function' 'Data.Void.Void'@ instance is defined in
-- @quickcheck-instances@.
functionVoid :: (forall b. void -> b) -> void :-> c
functionVoid :: forall void c. (forall b. void -> b) -> void :-> c
functionVoid forall b. void -> b
_ = forall a c. a :-> c
Nil

-- | The basic building block for 'Function' instances.
-- Provides a 'Function' instance by mapping to and from a type that
-- already has a 'Function' instance.
functionMap :: Function b => (a->b) -> (b->a) -> (a->c) -> (a:->c)
functionMap :: forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap = forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith forall a b. Function a => (a -> b) -> a :-> b
function

-- | @since 2.13.3
functionMapWith :: ((b->c) -> (b:->c)) -> (a->b) -> (b->a) -> (a->c) -> (a:->c)
functionMapWith :: forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (b -> c) -> b :-> c
function a -> b
g b -> a
h a -> c
f = forall a b c. (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
Map a -> b
g b -> a
h ((b -> c) -> b :-> c
function (\b
b -> a -> c
f (b -> a
h b
b)))

instance Function () where
  function :: forall b. (() -> b) -> () :-> b
function () -> b
f = forall c. c -> () :-> c
Unit (() -> b
f ())

instance Function a => Function (Const a b) where
  function :: forall b. (Const a b -> b) -> Const a b :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {k} a (b :: k). Const a b -> a
getConst forall {k} a (b :: k). a -> Const a b
Const

instance Function a => Function (Identity a) where
  function :: forall b. (Identity a -> b) -> Identity a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Identity a -> a
runIdentity forall a. a -> Identity a
Identity

instance (Function a, Function b) => Function (a,b) where
  function :: forall b. ((a, b) -> b) -> (a, b) :-> b
function = forall a b c.
((a -> b -> c) -> a :-> (b -> c))
-> ((b -> c) -> b :-> c) -> ((a, b) -> c) -> (a, b) :-> c
functionPairWith forall a b. Function a => (a -> b) -> a :-> b
function forall a b. Function a => (a -> b) -> a :-> b
function

-- | @since 2.13.3
functionPairWith :: ((a->b->c) -> (a:->(b->c))) -> ((b->c) -> (b:->c)) -> ((a,b)->c) -> ((a,b):->c)
functionPairWith :: forall a b c.
((a -> b -> c) -> a :-> (b -> c))
-> ((b -> c) -> b :-> c) -> ((a, b) -> c) -> (a, b) :-> c
functionPairWith (a -> b -> c) -> a :-> (b -> c)
func1 (b -> c) -> b :-> c
func2 (a, b) -> c
f = forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
Pair ((b -> c) -> b :-> c
func2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (a -> b -> c) -> a :-> (b -> c)
func1 (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> c
f))

instance (Function a, Function b) => Function (Either a b) where
  function :: forall b. (Either a b -> b) -> Either a b :-> b
function = forall a c b.
((a -> c) -> a :-> c)
-> ((b -> c) -> b :-> c) -> (Either a b -> c) -> Either a b :-> c
functionEitherWith forall a b. Function a => (a -> b) -> a :-> b
function forall a b. Function a => (a -> b) -> a :-> b
function

-- | @since 2.13.3
functionEitherWith :: ((a->c) -> (a:->c)) -> ((b->c) -> (b:->c)) -> (Either a b->c) -> (Either a b:->c)
functionEitherWith :: forall a c b.
((a -> c) -> a :-> c)
-> ((b -> c) -> b :-> c) -> (Either a b -> c) -> Either a b :-> c
functionEitherWith (a -> c) -> a :-> c
func1 (b -> c) -> b :-> c
func2 Either a b -> c
f = (a -> c) -> a :-> c
func1 (Either a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
:+: (b -> c) -> b :-> c
func2 (Either a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

-- tuple convenience instances

instance (Function a, Function b, Function c) => Function (a,b,c) where
  function :: forall b. ((a, b, c) -> b) -> (a, b, c) :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(a
a,b
b,c
c) -> (a
a,(b
b,c
c))) (\(a
a,(b
b,c
c)) -> (a
a,b
b,c
c))

instance (Function a, Function b, Function c, Function d) => Function (a,b,c,d) where
  function :: forall b. ((a, b, c, d) -> b) -> (a, b, c, d) :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(a
a,b
b,c
c,d
d) -> (a
a,(b
b,c
c,d
d))) (\(a
a,(b
b,c
c,d
d)) -> (a
a,b
b,c
c,d
d))

instance (Function a, Function b, Function c, Function d, Function e) => Function (a,b,c,d,e) where
  function :: forall b. ((a, b, c, d, e) -> b) -> (a, b, c, d, e) :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(a
a,b
b,c
c,d
d,e
e) -> (a
a,(b
b,c
c,d
d,e
e))) (\(a
a,(b
b,c
c,d
d,e
e)) -> (a
a,b
b,c
c,d
d,e
e))

instance (Function a, Function b, Function c, Function d, Function e, Function f) => Function (a,b,c,d,e,f) where
  function :: forall b. ((a, b, c, d, e, f) -> b) -> (a, b, c, d, e, f) :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(a
a,b
b,c
c,d
d,e
e,f
f) -> (a
a,(b
b,c
c,d
d,e
e,f
f))) (\(a
a,(b
b,c
c,d
d,e
e,f
f)) -> (a
a,b
b,c
c,d
d,e
e,f
f))

instance (Function a, Function b, Function c, Function d, Function e, Function f, Function g) => Function (a,b,c,d,e,f,g) where
  function :: forall b.
((a, b, c, d, e, f, g) -> b) -> (a, b, c, d, e, f, g) :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(a
a,b
b,c
c,d
d,e
e,f
f,g
g) -> (a
a,(b
b,c
c,d
d,e
e,f
f,g
g))) (\(a
a,(b
b,c
c,d
d,e
e,f
f,g
g)) -> (a
a,b
b,c
c,d
d,e
e,f
f,g
g))

-- other instances

instance Function a => Function [a] where
  function :: forall b. ([a] -> b) -> [a] :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {a}. [a] -> Either () (a, [a])
g forall {a} {a}. Either a (a, [a]) -> [a]
h
   where
    g :: [a] -> Either () (a, [a])
g []     = forall a b. a -> Either a b
Left ()
    g (a
x:[a]
xs) = forall a b. b -> Either a b
Right (a
x,[a]
xs)

    h :: Either a (a, [a]) -> [a]
h (Left a
_)       = []
    h (Right (a
x,[a]
xs)) = a
xforall a. a -> [a] -> [a]
:[a]
xs

instance Function a => Function (Maybe a) where
  function :: forall b. (Maybe a -> b) -> Maybe a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {b}. Maybe b -> Either () b
g forall {a} {a}. Either a a -> Maybe a
h
   where
    g :: Maybe b -> Either () b
g Maybe b
Nothing  = forall a b. a -> Either a b
Left ()
    g (Just b
x) = forall a b. b -> Either a b
Right b
x

    h :: Either a a -> Maybe a
h (Left a
_)  = forall a. Maybe a
Nothing
    h (Right a
x) = forall a. a -> Maybe a
Just a
x

instance Function Bool where
  function :: forall b. (Bool -> b) -> Bool :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Bool -> Either () ()
g forall {a} {b}. Either a b -> Bool
h
   where
    g :: Bool -> Either () ()
g Bool
False = forall a b. a -> Either a b
Left ()
    g Bool
True  = forall a b. b -> Either a b
Right ()

    h :: Either a b -> Bool
h (Left a
_)  = Bool
False
    h (Right b
_) = Bool
True

instance Function Integer where
  function :: forall b. (Integer -> b) -> Integer :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {t}. Integral t => t -> Either [Word8] [Word8]
gInteger forall {a} {a} {a}.
(Integral a, Integral a, Num a) =>
Either [a] [a] -> a
hInteger
   where
    gInteger :: t -> Either [Word8] [Word8]
gInteger t
n | t
n forall a. Ord a => a -> a -> Bool
< t
0     = forall a b. a -> Either a b
Left (forall {t}. Integral t => t -> [Word8]
gNatural (forall a. Num a => a -> a
abs t
n forall a. Num a => a -> a -> a
- t
1))
               | Bool
otherwise = forall a b. b -> Either a b
Right (forall {t}. Integral t => t -> [Word8]
gNatural t
n)

    hInteger :: Either [a] [a] -> a
hInteger (Left [a]
ws)  = -(forall {a} {a}. (Integral a, Num a) => [a] -> a
hNatural [a]
ws forall a. Num a => a -> a -> a
+ a
1)
    hInteger (Right [a]
ws) = forall {a} {a}. (Integral a, Num a) => [a] -> a
hNatural [a]
ws

    gNatural :: t -> [Word8]
gNatural t
0 = []
    gNatural t
n = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (t
n forall a. Integral a => a -> a -> a
`mod` t
256) :: Word8) forall a. a -> [a] -> [a]
: t -> [Word8]
gNatural (t
n forall a. Integral a => a -> a -> a
`div` t
256)

    hNatural :: [a] -> a
hNatural []     = a
0
    hNatural (a
w:[a]
ws) = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w forall a. Num a => a -> a -> a
+ a
256 forall a. Num a => a -> a -> a
* [a] -> a
hNatural [a]
ws

instance Function Int where
  function :: forall b. (Int -> b) -> Int :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Word where
  function :: forall b. (Word -> b) -> Word :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Char where
  function :: forall b. (Char -> b) -> Char :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Char -> Int
ord Int -> Char
chr

instance Function Float where
  function :: forall b. (Float -> b) -> Float :-> b
function = forall a b. RealFrac a => (a -> b) -> a :-> b
functionRealFrac

instance Function Double where
  function :: forall b. (Double -> b) -> Double :-> b
function = forall a b. RealFrac a => (a -> b) -> a :-> b
functionRealFrac

-- instances for assorted types in the base package

instance Function Ordering where
  function :: forall b. (Ordering -> b) -> Ordering :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Ordering -> Either Bool ()
g forall {b}. Either Bool b -> Ordering
h
    where
      g :: Ordering -> Either Bool ()
g Ordering
LT = forall a b. a -> Either a b
Left Bool
False
      g Ordering
EQ = forall a b. a -> Either a b
Left Bool
True
      g Ordering
GT = forall a b. b -> Either a b
Right ()

      h :: Either Bool b -> Ordering
h (Left Bool
False) = Ordering
LT
      h (Left Bool
True)  = Ordering
EQ
      h (Right b
_)    = Ordering
GT

instance (Integral a, Function a) => Function (Ratio a) where
  function :: forall b. (Ratio a -> b) -> Ratio a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {b}. Ratio b -> (b, b)
g forall {a}. Integral a => (a, a) -> Ratio a
h
   where
     g :: Ratio b -> (b, b)
g Ratio b
r = (forall a. Ratio a -> a
numerator Ratio b
r, forall a. Ratio a -> a
denominator Ratio b
r)
     h :: (a, a) -> Ratio a
h (a
n, a
d) = a
n forall a. Integral a => a -> a -> Ratio a
% a
d

#ifndef NO_FIXED
instance HasResolution a => Function (Fixed a) where
  function :: forall b. (Fixed a -> b) -> Fixed a :-> b
function = forall a b. RealFrac a => (a -> b) -> a :-> b
functionRealFrac
#endif

instance (RealFloat a, Function a) => Function (Complex a) where
  function :: forall b. (Complex a -> b) -> Complex a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {b}. Complex b -> (b, b)
g forall {a}. (a, a) -> Complex a
h
   where
     g :: Complex b -> (b, b)
g (b
x :+ b
y) = (b
x,   b
y)
     h :: (a, a) -> Complex a
h (a
x,   a
y) =  a
x forall a. a -> a -> Complex a
:+ a
y

instance (Ord a, Function a) => Function (Set.Set a) where
  function :: forall b. (Set a -> b) -> Set a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Set a -> [a]
Set.toList forall a. Ord a => [a] -> Set a
Set.fromList

instance (Ord a, Function a, Function b) => Function (Map.Map a b) where
  function :: forall b. (Map a b -> b) -> Map a b :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall k a. Map k a -> [(k, a)]
Map.toList forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

instance Function IntSet.IntSet where
  function :: forall b. (IntSet -> b) -> IntSet :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap IntSet -> [Int]
IntSet.toList [Int] -> IntSet
IntSet.fromList

instance Function a => Function (IntMap.IntMap a) where
  function :: forall b. (IntMap a -> b) -> IntMap a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. IntMap a -> [(Int, a)]
IntMap.toList forall a. [(Int, a)] -> IntMap a
IntMap.fromList

instance Function a => Function (Sequence.Seq a) where
  function :: forall b. (Seq a -> b) -> Seq a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a. [a] -> Seq a
Sequence.fromList

instance Function a => Function (Tree.Tree a) where
  function :: forall b. (Tree a -> b) -> Tree a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(Tree.Node a
x [Tree a]
xs) -> (a
x,[Tree a]
xs)) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> [Tree a] -> Tree a
Tree.Node)

instance Function Int8 where
  function :: forall b. (Int8 -> b) -> Int8 :-> b
function = forall a b. (Eq a, Bounded a, Enum a) => (a -> b) -> a :-> b
functionBoundedEnum

instance Function Int16 where
  function :: forall b. (Int16 -> b) -> Int16 :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Int32 where
  function :: forall b. (Int32 -> b) -> Int32 :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Int64 where
  function :: forall b. (Int64 -> b) -> Int64 :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Word8 where
  function :: forall b. (Word8 -> b) -> Word8 :-> b
function = forall a b. (Eq a, Bounded a, Enum a) => (a -> b) -> a :-> b
functionBoundedEnum

instance Function Word16 where
  function :: forall b. (Word16 -> b) -> Word16 :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Word32 where
  function :: forall b. (Word32 -> b) -> Word32 :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

instance Function Word64 where
  function :: forall b. (Word64 -> b) -> Word64 :-> b
function = forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

#if defined(MIN_VERSION_base)
#if MIN_VERSION_base(4,2,0)
instance Function Newline where
  function :: forall b. (Newline -> b) -> Newline :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Newline -> Bool
g Bool -> Newline
h
    where
      g :: Newline -> Bool
g Newline
LF = Bool
False
      g Newline
CRLF = Bool
True

      h :: Bool -> Newline
h Bool
False = Newline
LF
      h Bool
True = Newline
CRLF

instance Function NewlineMode where
  function :: forall b. (NewlineMode -> b) -> NewlineMode :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap NewlineMode -> (Newline, Newline)
g (Newline, Newline) -> NewlineMode
h
    where
      g :: NewlineMode -> (Newline, Newline)
g (NewlineMode Newline
inNL Newline
outNL) = (Newline
inNL,Newline
outNL)
      h :: (Newline, Newline) -> NewlineMode
h (Newline
inNL,Newline
outNL) = Newline -> Newline -> NewlineMode
NewlineMode Newline
inNL Newline
outNL
#endif
#endif

-- instances for Data.Monoid newtypes

instance Function a => Function (Monoid.Dual a) where
  function :: forall b. (Dual a -> b) -> Dual a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Dual a -> a
Monoid.getDual forall a. a -> Dual a
Monoid.Dual

instance Function Monoid.All where
  function :: forall b. (All -> b) -> All :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap All -> Bool
Monoid.getAll Bool -> All
Monoid.All

instance Function Monoid.Any where
  function :: forall b. (Any -> b) -> Any :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Any -> Bool
Monoid.getAny Bool -> Any
Monoid.Any

instance Function a => Function (Monoid.Sum a) where
  function :: forall b. (Sum a -> b) -> Sum a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Sum a -> a
Monoid.getSum forall a. a -> Sum a
Monoid.Sum

instance Function a => Function (Monoid.Product a) where
  function :: forall b. (Product a -> b) -> Product a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Product a -> a
Monoid.getProduct forall a. a -> Product a
Monoid.Product

instance Function a => Function (Monoid.First a) where
  function :: forall b. (First a -> b) -> First a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. First a -> Maybe a
Monoid.getFirst forall a. Maybe a -> First a
Monoid.First

instance Function a => Function (Monoid.Last a) where
  function :: forall b. (Last a -> b) -> Last a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall a. Last a -> Maybe a
Monoid.getLast forall a. Maybe a -> Last a
Monoid.Last

#if MIN_VERSION_base(4,8,0)
instance Function (f a) => Function (Monoid.Alt f a) where
  function :: forall b. (Alt f a -> b) -> Alt f a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt
#endif

-- poly instances

instance Function A where
  function :: forall b. (A -> b) -> A :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap A -> Integer
unA Integer -> A
A

instance Function B where
  function :: forall b. (B -> b) -> B :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap B -> Integer
unB Integer -> B
B

instance Function C where
  function :: forall b. (C -> b) -> C :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap C -> Integer
unC Integer -> C
C

instance Function OrdA where
  function :: forall b. (OrdA -> b) -> OrdA :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap OrdA -> Integer
unOrdA Integer -> OrdA
OrdA

instance Function OrdB where
  function :: forall b. (OrdB -> b) -> OrdB :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap OrdB -> Integer
unOrdB Integer -> OrdB
OrdB

instance Function OrdC where
  function :: forall b. (OrdC -> b) -> OrdC :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap OrdC -> Integer
unOrdC Integer -> OrdC
OrdC

-- instance Arbitrary

instance (Function a, CoArbitrary a, Arbitrary b) => Arbitrary (a:->b) where
  arbitrary :: Gen (a :-> b)
arbitrary = forall a b. Function a => (a -> b) -> a :-> b
function forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Arbitrary a => Gen a
arbitrary
  shrink :: (a :-> b) -> [a :-> b]
shrink    = forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun forall a. Arbitrary a => a -> [a]
shrink

--------------------------------------------------------------------------
-- generic function instances

#ifndef NO_GENERICS
-- | Generic 'Function' implementation.
genericFunction :: (Generic a, GFunction (Rep a)) => (a->b) -> (a:->b)
genericFunction :: forall a b. (Generic a, GFunction (Rep a)) => (a -> b) -> a :-> b
genericFunction = forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction forall a x. Generic a => a -> Rep a x
from forall a x. Generic a => Rep a x -> a
to

class GFunction f where
  gFunction :: (f a -> b) -> (f a :-> b)

instance GFunction U1 where
  gFunction :: forall (a :: k) b. (U1 a -> b) -> U1 a :-> b
gFunction = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\U1 a
U1 -> ()) (\() -> forall k (p :: k). U1 p
U1)

instance (GFunction f, GFunction g) => GFunction (f :*: g) where
  gFunction :: forall (a :: k) b. ((:*:) f g a -> b) -> (:*:) f g a :-> b
gFunction = forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (forall a b c.
((a -> b -> c) -> a :-> (b -> c))
-> ((b -> c) -> b :-> c) -> ((a, b) -> c) -> (a, b) :-> c
functionPairWith forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction) forall {k} {f :: k -> *} {g :: k -> *} {p :: k}.
(:*:) f g p -> (f p, g p)
g forall {k} {f :: k -> *} {p :: k} {g :: k -> *}.
(f p, g p) -> (:*:) f g p
h
   where
     g :: (:*:) f g p -> (f p, g p)
g (f p
x :*: g p
y) = (f p
x, g p
y)
     h :: (f p, g p) -> (:*:) f g p
h (f p
x, g p
y) = f p
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
y

instance (GFunction f, GFunction g) => GFunction (f :+: g) where
  gFunction :: forall (a :: k) b. ((:+:) f g a -> b) -> (:+:) f g a :-> b
gFunction = forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (forall a c b.
((a -> c) -> a :-> c)
-> ((b -> c) -> b :-> c) -> (Either a b -> c) -> Either a b :-> c
functionEitherWith forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction) forall {k} {f :: k -> *} {g :: k -> *} {p :: k}.
(:+:) f g p -> Either (f p) (g p)
g forall {k} {f :: k -> *} {p :: k} {g :: k -> *}.
Either (f p) (g p) -> (:+:) f g p
h
   where
     g :: (:+:) f g p -> Either (f p) (g p)
g (L1 f p
x) = forall a b. a -> Either a b
Left f p
x
     g (R1 g p
x) = forall a b. b -> Either a b
Right g p
x
     h :: Either (f p) (g p) -> (:+:) f g p
h (Left f p
x) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x
     h (Right g p
x) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
x

instance GFunction f => GFunction (M1 i c f) where
  gFunction :: forall (a :: k) b. (M1 i c f a -> b) -> M1 i c f a :-> b
gFunction = forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction (\(M1 f a
x) -> f a
x) forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1

instance Function a => GFunction (K1 i a) where
  gFunction :: forall (a :: k) b. (K1 i a a -> b) -> K1 i a a :-> b
gFunction = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(K1 a
x) -> a
x) forall k i c (p :: k). c -> K1 i c p
K1
#endif

--------------------------------------------------------------------------
-- shrinking

shrinkFun :: (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun :: forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun c -> [c]
shr (Pair a :-> (b :-> c)
p) =
  [ forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
pair a :-> (b :-> c)
p' | a :-> (b :-> c)
p' <- forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun (\b :-> c
q -> forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun c -> [c]
shr b :-> c
q) a :-> (b :-> c)
p ]
 where
  pair :: (a :-> (b :-> c)) -> (a, b) :-> c
pair a :-> (b :-> c)
Nil = forall a c. a :-> c
Nil
  pair a :-> (b :-> c)
p   = forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
Pair a :-> (b :-> c)
p

shrinkFun c -> [c]
shr (a :-> c
p :+: b :-> c
q) =
  [ a :-> c
p forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. forall a c. a :-> c
Nil | Bool -> Bool
not (forall a b. (a :-> b) -> Bool
isNil b :-> c
q) ] forall a. [a] -> [a] -> [a]
++
  [ forall a c. a :-> c
Nil forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
q | Bool -> Bool
not (forall a b. (a :-> b) -> Bool
isNil a :-> c
p) ] forall a. [a] -> [a] -> [a]
++
  [ a :-> c
p  forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
q' | b :-> c
q' <- forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun c -> [c]
shr b :-> c
q ] forall a. [a] -> [a] -> [a]
++
  [ a :-> c
p' forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
q  | a :-> c
p' <- forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun c -> [c]
shr a :-> c
p ]
 where
  isNil :: (a :-> b) -> Bool
  isNil :: forall a b. (a :-> b) -> Bool
isNil a :-> b
Nil = Bool
True
  isNil a :-> b
_   = Bool
False

  a :-> c
Nil .+. :: (a :-> c) -> (b :-> c) -> Either a b :-> c
.+. b :-> c
Nil = forall a c. a :-> c
Nil
  a :-> c
p   .+. b :-> c
q   = a :-> c
p forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
:+: b :-> c
q

shrinkFun c -> [c]
shr (Unit c
c) =
  [ forall a c. a :-> c
Nil ] forall a. [a] -> [a] -> [a]
++
  [ forall c. c -> () :-> c
Unit c
c' | c
c' <- c -> [c]
shr c
c ]

shrinkFun c -> [c]
shr (Table [(a, c)]
xys) =
  [ forall a c. Eq a => [(a, c)] -> a :-> c
table [(a, c)]
xys' | [(a, c)]
xys' <- forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (a, c) -> [(a, c)]
shrXy [(a, c)]
xys ]
 where
  shrXy :: (a, c) -> [(a, c)]
shrXy (a
x,c
y) = [(a
x,c
y') | c
y' <- c -> [c]
shr c
y]

  table :: [(a, c)] -> a :-> c
table []  = forall a c. a :-> c
Nil
  table [(a, c)]
xys = forall a c. Eq a => [(a, c)] -> a :-> c
Table [(a, c)]
xys

shrinkFun c -> [c]
shr a :-> c
Nil =
  []

shrinkFun c -> [c]
shr (Map a -> b
g b -> a
h b :-> c
p) =
  [ forall a b c. (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
mapp a -> b
g b -> a
h b :-> c
p' | b :-> c
p' <- forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun c -> [c]
shr b :-> c
p ]
 where
  mapp :: (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
mapp a -> b
g b -> a
h b :-> c
Nil = forall a c. a :-> c
Nil
  mapp a -> b
g b -> a
h b :-> c
p   = forall a b c. (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
Map a -> b
g b -> a
h b :-> c
p

--------------------------------------------------------------------------
-- the Fun modifier

-- | Generation of random shrinkable, showable functions.
--
-- To generate random values of type @'Fun' a b@,
-- you must have an instance @'Function' a@.
--
-- See also 'applyFun', and 'Fn' with GHC >= 7.8.
data Fun a b = Fun (a :-> b, b, Shrunk) (a -> b)
data Shrunk = Shrunk | NotShrunk deriving Shrunk -> Shrunk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shrunk -> Shrunk -> Bool
$c/= :: Shrunk -> Shrunk -> Bool
== :: Shrunk -> Shrunk -> Bool
$c== :: Shrunk -> Shrunk -> Bool
Eq

instance Functor (Fun a) where
  fmap :: forall a b. (a -> b) -> Fun a a -> Fun a b
fmap a -> b
f (Fun (a :-> a
p, a
d, Shrunk
s) a -> a
g) = forall a b. (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
Fun (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a :-> a
p, a -> b
f a
d, Shrunk
s) (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g)

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
-- | A modifier for testing functions.
--
-- > prop :: Fun String Integer -> Bool
-- > prop (Fn f) = f "banana" == f "monkey"
-- >            || f "banana" == f "elephant"
#if __GLASGOW_HASKELL__ >= 800
pattern Fn :: (a -> b) -> Fun a b
#endif
pattern $mFn :: forall {r} {a} {b}. Fun a b -> ((a -> b) -> r) -> ((# #) -> r) -> r
Fn f <- (applyFun -> f)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Fn #-}
#endif

-- | A modifier for testing binary functions.
--
-- > prop_zipWith :: Fun (Int, Bool) Char -> [Int] -> [Bool] -> Bool
-- > prop_zipWith (Fn2 f) xs ys = zipWith f xs ys == [ f x y | (x, y) <- zip xs ys]
#if __GLASGOW_HASKELL__ >= 800
pattern Fn2 :: (a -> b -> c) -> Fun (a, b) c
#endif
pattern $mFn2 :: forall {r} {a} {b} {c}.
Fun (a, b) c -> ((a -> b -> c) -> r) -> ((# #) -> r) -> r
Fn2 f <- (applyFun2 -> f)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Fn2 #-}
#endif

-- | A modifier for testing ternary functions.
#if __GLASGOW_HASKELL__ >= 800
pattern Fn3 :: (a -> b -> c -> d) -> Fun (a, b, c) d
#endif
pattern $mFn3 :: forall {r} {a} {b} {c} {d}.
Fun (a, b, c) d -> ((a -> b -> c -> d) -> r) -> ((# #) -> r) -> r
Fn3 f <- (applyFun3 -> f)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE Fn3 #-}
#endif
#endif

mkFun :: (a :-> b) -> b -> Fun a b
mkFun :: forall a b. (a :-> b) -> b -> Fun a b
mkFun a :-> b
p b
d = forall a b. (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
Fun (a :-> b
p, b
d, Shrunk
NotShrunk) (forall a c. (a :-> c) -> c -> a -> c
abstract a :-> b
p b
d)

-- | Alias to 'applyFun'.
apply :: Fun a b -> (a -> b)
apply :: forall a b. Fun a b -> a -> b
apply = forall a b. Fun a b -> a -> b
applyFun

-- | Extracts the value of a function.
--
-- 'Fn' is the pattern equivalent of this function.
--
-- > prop :: Fun String Integer -> Bool
-- > prop f = applyFun f "banana" == applyFun f "monkey"
-- >       || applyFun f "banana" == applyFun f "elephant"
applyFun :: Fun a b -> (a -> b)
applyFun :: forall a b. Fun a b -> a -> b
applyFun (Fun (a :-> b, b, Shrunk)
_ a -> b
f) = a -> b
f

-- | Extracts the value of a binary function.
--
-- 'Fn2' is the pattern equivalent of this function.
--
--  > prop_zipWith :: Fun (Int, Bool) Char -> [Int] -> [Bool] -> Bool
--  > prop_zipWith f xs ys = zipWith (applyFun2 f) xs ys == [ applyFun2 f x y | (x, y) <- zip xs ys]
--
applyFun2 :: Fun (a, b) c -> (a -> b -> c)
applyFun2 :: forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 (Fun ((a, b) :-> c, c, Shrunk)
_ (a, b) -> c
f) a
a b
b = (a, b) -> c
f (a
a, b
b)

-- | Extracts the value of a ternary function. 'Fn3' is the
-- pattern equivalent of this function.
applyFun3 :: Fun (a, b, c) d -> (a -> b -> c -> d)
applyFun3 :: forall a b c d. Fun (a, b, c) d -> a -> b -> c -> d
applyFun3 (Fun ((a, b, c) :-> d, d, Shrunk)
_ (a, b, c) -> d
f) a
a b
b c
c = (a, b, c) -> d
f (a
a, b
b, c
c)

instance (Show a, Show b) => Show (Fun a b) where
  show :: Fun a b -> String
show (Fun (a :-> b
_, b
_, Shrunk
NotShrunk) a -> b
_) = String
"<fun>"
  show (Fun (a :-> b
p, b
d, Shrunk
Shrunk) a -> b
_)    = forall a b. (Show a, Show b) => (a :-> b) -> Maybe b -> String
showFunction a :-> b
p (forall a. a -> Maybe a
Just b
d)

instance (Function a, CoArbitrary a, Arbitrary b) => Arbitrary (Fun a b) where
  arbitrary :: Gen (Fun a b)
arbitrary =
    do a :-> b
p <- forall a. Arbitrary a => Gen a
arbitrary
       b
d <- forall a. Arbitrary a => Gen a
arbitrary
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a :-> b) -> b -> Fun a b
mkFun a :-> b
p b
d)

  shrink :: Fun a b -> [Fun a b]
shrink (Fun (a :-> b
p, b
d, Shrunk
s) a -> b
f) =
    [ forall a b. (a :-> b) -> b -> Fun a b
mkFun a :-> b
p' b
d' | (a :-> b
p', b
d') <- forall a. Arbitrary a => a -> [a]
shrink (a :-> b
p, b
d) ] forall a. [a] -> [a] -> [a]
++
    [ forall a b. (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
Fun (a :-> b
p, b
d, Shrunk
Shrunk) a -> b
f | Shrunk
s forall a. Eq a => a -> a -> Bool
== Shrunk
NotShrunk ]

--------------------------------------------------------------------------
-- the end.