{-# 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
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
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
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
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
"}"
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)
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 ]
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
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]
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]
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
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
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
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
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
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
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
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)
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))
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
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
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
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 (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
#ifndef NO_GENERICS
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
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
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
#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
#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
#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)
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
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
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)
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 ]