{-# LANGUAGE TypeOperators, GADTs, CPP, Rank2Types #-}
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Trustworthy #-}
#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(..)
  , mkFun
  , 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
import qualified Data.Semigroup as Semigroup
import qualified Data.List.NonEmpty as NonEmpty
import Numeric.Natural
import qualified Data.Bits as Bits
import Data.Tuple
import Data.Ord
import Data.Functor.Contravariant
import Text.Printf
import System.IO
import System.Exit
import Data.Version
import Data.Array.Byte
import qualified GHC.Exts as Exts

#if defined(__MHS__)
import Data.ZipList
import Control.WrappedMonad
#endif

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

#ifndef NO_FIXED
import Data.Fixed
#endif

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

import Test.QuickCheck.Compat

--------------------------------------------------------------------------
-- 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)    = (a :-> (b :-> b)) -> (a, b) :-> b
forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
Pair (((b :-> a) -> b :-> b) -> (a :-> (b :-> a)) -> a :-> (b :-> b)
forall a b. (a -> b) -> (a :-> a) -> a :-> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (b :-> a) -> b :-> b
forall a b. (a -> b) -> (b :-> a) -> b :-> b
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)     = (a -> b) -> (a :-> a) -> a :-> b
forall a b. (a -> b) -> (a :-> a) -> a :-> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a :-> a
p (a :-> b) -> (b :-> b) -> Either a b :-> b
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
:+: (a -> b) -> (b :-> a) -> b :-> b
forall a b. (a -> b) -> (b :-> a) -> b :-> b
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)    = b -> () :-> b
forall c. c -> () :-> c
Unit (a -> b
f a
c)
  fmap a -> b
f a :-> a
Nil         = a :-> b
forall a c. a :-> c
Nil
  fmap a -> b
f (Table [(a, a)]
xys) = [(a, b)] -> a :-> b
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) = (a -> b) -> (b -> a) -> (b :-> b) -> a :-> b
forall a b c. (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
Map a -> b
g b -> a
h ((a -> b) -> (b :-> a) -> b :-> b
forall a b. (a -> b) -> (b :-> a) -> b :-> b
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 = (a :-> b) -> Maybe b -> String
forall a b. (Show a, Show b) => (a :-> b) -> Maybe b -> String
showFunction a :-> b
p Maybe b
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
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ( [ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
c
                                    | (a
x,b
c) <- (a :-> b) -> [(a, b)]
forall a c. (a :-> c) -> [(a, c)]
table a :-> b
p
                                    ]
                                 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"_->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
d
                                    | Just b
d <- [Maybe b
md]
                                    ] )) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

-- turning a concrete function into an abstract function (with a default result)
abstract :: (a :-> c) -> c -> (a -> c)
#if defined(__MHS__)
{- This is a temporary fix for a deficiency in the MicroHs type checker. -}
abstract (Pair p)    d xy    =
  case xy of
    (x,y) -> abstract (fmap (\q -> abstract q d y) p) d x
#else
abstract :: forall a c. (a :-> c) -> c -> a -> c
abstract (Pair a :-> (b :-> c)
p)    c
d (a
x,b
y) = (a :-> c) -> c -> a -> c
forall a c. (a :-> c) -> c -> a -> c
abstract (((b :-> c) -> c) -> (a :-> (b :-> c)) -> a :-> c
forall a b. (a -> b) -> (a :-> a) -> a :-> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b :-> c
q -> (b :-> c) -> c -> b -> c
forall a c. (a :-> c) -> c -> a -> c
abstract b :-> c
q c
d b
y) a :-> (b :-> c)
p) c
d a
x
#endif
abstract (a :-> c
p :+: b :-> c
q)   c
d a
exy   = (a -> c) -> (b -> c) -> Either a b -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a :-> c) -> c -> a -> c
forall a c. (a :-> c) -> c -> a -> c
abstract a :-> c
p c
d) ((b :-> c) -> c -> b -> c
forall a c. (a :-> c) -> c -> a -> c
abstract b :-> c
q c
d) a
Either a b
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     = [c] -> c
forall a. HasCallStack => [a] -> a
head ([c
y | (a
x',c
y) <- [(a, c)]
xys, a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x'] [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c
d])
abstract (Map a -> b
g b -> a
_ b :-> c
p) c
d a
x     = (b :-> c) -> c -> b -> c
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) <- (a :-> (b :-> c)) -> [(a, b :-> c)]
forall a c. (a :-> c) -> [(a, c)]
table a :-> (b :-> c)
p, (b
y,c
c) <- (b :-> c) -> [(b, c)]
forall a c. (a :-> c) -> [(a, c)]
table b :-> c
q ]
table (a :-> c
p :+: b :-> c
q)   = [ (a -> Either a b
forall a b. a -> Either a b
Left a
x, c
c) | (a
x,c
c) <- (a :-> c) -> [(a, c)]
forall a c. (a :-> c) -> [(a, c)]
table a :-> c
p ]
                 [(a, c)] -> [(a, c)] -> [(a, c)]
forall a. [a] -> [a] -> [a]
++ [ (b -> Either a b
forall a b. b -> Either a b
Right b
y,c
c) | (b
y,c
c) <- (b :-> c) -> [(b, 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) <- (b :-> c) -> [(b, 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 = (a -> b) -> a :-> b
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 = [a] -> (a -> b) -> a :-> b
forall a b. Eq a => [a] -> (a -> b) -> a :-> b
functionElements [a
forall a. Bounded a => a
minBound..a
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 = [(a, b)] -> a :-> b
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 = (a -> Rational) -> (Rational -> a) -> (a -> b) -> a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap a -> Rational
forall a. Real a => a -> Rational
toRational Rational -> a
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 = (a -> Integer) -> (Integer -> a) -> (a -> b) -> a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer -> a
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 = (a -> String) -> (String -> a) -> (a -> c) -> a :-> c
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap a -> String
forall a. Show a => a -> String
show String -> a
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
_ = void :-> c
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 = ((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (b -> c) -> b :-> c
forall a b. Function a => (a -> b) -> a :-> b
forall b. (b -> b) -> b :-> 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 = (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
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 = b -> () :-> b
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 = (Const a b -> a)
-> (a -> Const a b) -> (Const a b -> b) -> Const a b :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst a -> Const a b
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 = (Identity a -> a)
-> (a -> Identity a) -> (Identity a -> b) -> Identity a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Identity a -> a
forall a. Identity a -> a
runIdentity a -> Identity a
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 = ((a -> b -> b) -> a :-> (b -> b))
-> ((b -> b) -> b :-> b) -> ((a, b) -> b) -> (a, b) :-> b
forall a b c.
((a -> b -> c) -> a :-> (b -> c))
-> ((b -> c) -> b :-> c) -> ((a, b) -> c) -> (a, b) :-> c
functionPairWith (a -> b -> b) -> a :-> (b -> b)
forall a b. Function a => (a -> b) -> a :-> b
forall b. (a -> b) -> a :-> b
function (b -> b) -> b :-> b
forall a b. Function a => (a -> b) -> a :-> b
forall b. (b -> b) -> b :-> 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 = (a :-> (b :-> c)) -> (a, b) :-> c
forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
Pair ((b -> c) -> b :-> c
func2 ((b -> c) -> b :-> c) -> (a :-> (b -> c)) -> a :-> (b :-> c)
forall a b. (a -> b) -> (a :-> a) -> a :-> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (a -> b -> c) -> a :-> (b -> c)
func1 (((a, b) -> c) -> a -> b -> c
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 = ((a -> b) -> a :-> b)
-> ((b -> b) -> b :-> b) -> (Either a b -> b) -> Either a b :-> b
forall a c b.
((a -> c) -> a :-> c)
-> ((b -> c) -> b :-> c) -> (Either a b -> c) -> Either a b :-> c
functionEitherWith (a -> b) -> a :-> b
forall a b. Function a => (a -> b) -> a :-> b
forall b. (a -> b) -> a :-> b
function (b -> b) -> b :-> b
forall a b. Function a => (a -> b) -> a :-> b
forall b. (b -> b) -> b :-> 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 (Either a b -> c) -> (a -> Either a b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) (a :-> c) -> (b :-> c) -> Either a b :-> c
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
:+: (b -> c) -> b :-> c
func2 (Either a b -> c
f (Either a b -> c) -> (b -> Either a b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
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 = ((a, b, c) -> (a, (b, c)))
-> ((a, (b, c)) -> (a, b, c))
-> ((a, b, c) -> b)
-> (a, b, c) :-> b
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 = ((a, b, c, d) -> (a, (b, c, d)))
-> ((a, (b, c, d)) -> (a, b, c, d))
-> ((a, b, c, d) -> b)
-> (a, b, c, d) :-> b
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 = ((a, b, c, d, e) -> (a, (b, c, d, e)))
-> ((a, (b, c, d, e)) -> (a, b, c, d, e))
-> ((a, b, c, d, e) -> b)
-> (a, b, c, d, e) :-> b
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 = ((a, b, c, d, e, f) -> (a, (b, c, d, e, f)))
-> ((a, (b, c, d, e, f)) -> (a, b, c, d, e, f))
-> ((a, b, c, d, e, f) -> b)
-> (a, b, c, d, e, f) :-> b
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 = ((a, b, c, d, e, f, g) -> (a, (b, c, d, e, f, g)))
-> ((a, (b, c, d, e, f, g)) -> (a, b, c, d, e, f, g))
-> ((a, b, c, d, e, f, g) -> b)
-> (a, b, c, d, e, f, g) :-> b
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 = ([a] -> Either () (a, [a]))
-> (Either () (a, [a]) -> [a]) -> ([a] -> b) -> [a] :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap [a] -> Either () (a, [a])
forall {a}. [a] -> Either () (a, [a])
g Either () (a, [a]) -> [a]
forall {a} {a}. Either a (a, [a]) -> [a]
h
   where
    g :: [a] -> Either () (a, [a])
g []     = () -> Either () (a, [a])
forall a b. a -> Either a b
Left ()
    g (a
x:[a]
xs) = (a, [a]) -> Either () (a, [a])
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
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs

instance Function a => Function (NonEmpty.NonEmpty a) where
  function :: forall b. (NonEmpty a -> b) -> NonEmpty a :-> b
function = (NonEmpty a -> (a, [a]))
-> ((a, [a]) -> NonEmpty a)
-> (NonEmpty a -> b)
-> NonEmpty a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(a
a NonEmpty.:| [a]
as) -> (a
a, [a]
as)) (\(a
a, [a]
as) -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [a]
as)

instance Function a => Function (ZipList a) where
  function :: forall b. (ZipList a -> b) -> ZipList a :-> b
function = (ZipList a -> [a])
-> ([a] -> ZipList a) -> (ZipList a -> b) -> ZipList a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap ZipList a -> [a]
forall a. ZipList a -> [a]
getZipList [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList

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

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

instance Function Bool where
  function :: forall b. (Bool -> b) -> Bool :-> b
function = (Bool -> Either () ())
-> (Either () () -> Bool) -> (Bool -> b) -> Bool :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Bool -> Either () ()
g Either () () -> Bool
forall {a} {b}. Either a b -> Bool
h
   where
    g :: Bool -> Either () ()
g Bool
False = () -> Either () ()
forall a b. a -> Either a b
Left ()
    g Bool
True  = () -> Either () ()
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 = (Integer -> Either [Word8] [Word8])
-> (Either [Word8] [Word8] -> Integer)
-> (Integer -> b)
-> Integer :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Integer -> Either [Word8] [Word8]
forall {t}. Integral t => t -> Either [Word8] [Word8]
gInteger Either [Word8] [Word8] -> Integer
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 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0     = [Word8] -> Either [Word8] [Word8]
forall a b. a -> Either a b
Left (t -> [Word8]
forall {t}. Integral t => t -> [Word8]
gNatural (t -> t
forall a. Num a => a -> a
abs t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1))
               | Bool
otherwise = [Word8] -> Either [Word8] [Word8]
forall a b. b -> Either a b
Right (t -> [Word8]
forall {t}. Integral t => t -> [Word8]
gNatural t
n)

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

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

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

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

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

instance Function Char where
  function :: forall b. (Char -> b) -> Char :-> b
function = (Char -> Int) -> (Int -> Char) -> (Char -> b) -> Char :-> b
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 = (Float -> b) -> Float :-> b
forall a b. RealFrac a => (a -> b) -> a :-> b
functionRealFrac

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

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

-- instances for assorted types in the base package

instance Function Ordering where
  function :: forall b. (Ordering -> b) -> Ordering :-> b
function = (Ordering -> Either Bool ())
-> (Either Bool () -> Ordering)
-> (Ordering -> b)
-> Ordering :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Ordering -> Either Bool ()
g Either Bool () -> Ordering
forall {b}. Either Bool b -> Ordering
h
    where
      g :: Ordering -> Either Bool ()
g Ordering
LT = Bool -> Either Bool ()
forall a b. a -> Either a b
Left Bool
False
      g Ordering
EQ = Bool -> Either Bool ()
forall a b. a -> Either a b
Left Bool
True
      g Ordering
GT = () -> Either Bool ()
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 = (Ratio a -> (a, a))
-> ((a, a) -> Ratio a) -> (Ratio a -> b) -> Ratio a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Ratio a -> (a, a)
forall {b}. Ratio b -> (b, b)
g (a, a) -> Ratio a
forall {a}. Integral a => (a, a) -> Ratio a
h
   where
     g :: Ratio b -> (b, b)
g Ratio b
r = (Ratio b -> b
forall a. Ratio a -> a
numerator Ratio b
r, Ratio b -> b
forall a. Ratio a -> a
denominator Ratio b
r)
     h :: (a, a) -> Ratio a
h (a
n, a
d) = a
n a -> a -> Ratio a
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 = (Fixed a -> b) -> Fixed a :-> b
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 = (Complex a -> (a, a))
-> ((a, a) -> Complex a) -> (Complex a -> b) -> Complex a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Complex a -> (a, a)
forall {b}. Complex b -> (b, b)
g (a, a) -> Complex a
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 a -> a -> Complex a
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 = (Set a -> [a]) -> ([a] -> Set a) -> (Set a -> b) -> Set a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Set a -> [a]
forall a. Set a -> [a]
Set.toList [a] -> Set a
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 = (Map a b -> [(a, b)])
-> ([(a, b)] -> Map a b) -> (Map a b -> b) -> Map a b :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList [(a, b)] -> Map a b
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 = (IntSet -> [Int])
-> ([Int] -> IntSet) -> (IntSet -> b) -> IntSet :-> b
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 = (IntMap a -> [(Int, a)])
-> ([(Int, a)] -> IntMap a) -> (IntMap a -> b) -> IntMap a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList [(Int, a)] -> IntMap a
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 = (Seq a -> [a]) -> ([a] -> Seq a) -> (Seq a -> b) -> Seq a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [a] -> Seq a
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 = (Tree a -> (a, [Tree a]))
-> ((a, [Tree a]) -> Tree a) -> (Tree a -> b) -> Tree a :-> b
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)) ((a -> [Tree a] -> Tree a) -> (a, [Tree a]) -> Tree a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Tree.Node)

instance Function Int8 where
  function :: forall b. (Int8 -> b) -> Int8 :-> b
function = (Int8 -> b) -> Int8 :-> b
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 = (Int16 -> b) -> Int16 :-> b
forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

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

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

instance Function Word8 where
  function :: forall b. (Word8 -> b) -> Word8 :-> b
function = (Word8 -> b) -> Word8 :-> b
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 = (Word16 -> b) -> Word16 :-> b
forall a b. Integral a => (a -> b) -> a :-> b
functionIntegral

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

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

#if defined(MIN_VERSION_base)
instance Function Newline where
  function :: forall b. (Newline -> b) -> Newline :-> b
function = (Newline -> Bool)
-> (Bool -> Newline) -> (Newline -> b) -> Newline :-> b
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 = (NewlineMode -> (Newline, Newline))
-> ((Newline, Newline) -> NewlineMode)
-> (NewlineMode -> b)
-> NewlineMode :-> b
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

-- instances for Data.Monoid newtypes

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

instance Function Monoid.All where
  function :: forall b. (All -> b) -> All :-> b
function = (All -> Bool) -> (Bool -> All) -> (All -> b) -> All :-> b
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 = (Any -> Bool) -> (Bool -> Any) -> (Any -> b) -> Any :-> b
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 = (Sum a -> a) -> (a -> Sum a) -> (Sum a -> b) -> Sum a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Sum a -> a
forall a. Sum a -> a
Monoid.getSum a -> Sum a
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 = (Product a -> a)
-> (a -> Product a) -> (Product a -> b) -> Product a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Product a -> a
forall a. Product a -> a
Monoid.getProduct a -> Product a
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 = (First a -> Maybe a)
-> (Maybe a -> First a) -> (First a -> b) -> First a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap First a -> Maybe a
forall a. First a -> Maybe a
Monoid.getFirst Maybe a -> First a
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 = (Last a -> Maybe a)
-> (Maybe a -> Last a) -> (Last a -> b) -> Last a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Last a -> Maybe a
forall a. Last a -> Maybe a
Monoid.getLast Maybe a -> Last a
forall a. Maybe a -> Last a
Monoid.Last

instance Function (f a) => Function (Monoid.Alt f a) where
  function :: forall b. (Alt f a -> b) -> Alt f a :-> b
function = (Alt f a -> f a)
-> (f a -> Alt f a) -> (Alt f a -> b) -> Alt f a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Alt f a -> f a
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt

instance Function a => Function (Semigroup.Min a) where
  function :: forall b. (Min a -> b) -> Min a :-> b
function = (Min a -> a) -> (a -> Min a) -> (Min a -> b) -> Min a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Min a -> a
forall a. Min a -> a
Semigroup.getMin a -> Min a
forall a. a -> Min a
Semigroup.Min

instance Function a => Function (Semigroup.Max a) where
  function :: forall b. (Max a -> b) -> Max a :-> b
function = (Max a -> a) -> (a -> Max a) -> (Max a -> b) -> Max a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Max a -> a
forall a. Max a -> a
Semigroup.getMax a -> Max a
forall a. a -> Max a
Semigroup.Max

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

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

instance Function a => Function (Semigroup.WrappedMonoid a) where
  function :: forall b. (WrappedMonoid a -> b) -> WrappedMonoid a :-> b
function = (WrappedMonoid a -> a)
-> (a -> WrappedMonoid a)
-> (WrappedMonoid a -> b)
-> WrappedMonoid a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap WrappedMonoid a -> a
forall m. WrappedMonoid m -> m
Semigroup.unwrapMonoid a -> WrappedMonoid a
forall m. m -> WrappedMonoid m
Semigroup.WrapMonoid

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

#if MIN_VERSION_base(4,16,0)
instance Function a => Function (Bits.And a) where
  function :: forall b. (And a -> b) -> And a :-> b
function = (And a -> a) -> (a -> And a) -> (And a -> b) -> And a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap And a -> a
forall a. And a -> a
Bits.getAnd a -> And a
forall a. a -> And a
Bits.And

instance Function a => Function (Bits.Ior a) where
  function :: forall b. (Ior a -> b) -> Ior a :-> b
function = (Ior a -> a) -> (a -> Ior a) -> (Ior a -> b) -> Ior a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Ior a -> a
forall a. Ior a -> a
Bits.getIor a -> Ior a
forall a. a -> Ior a
Bits.Ior

instance Function a => Function (Bits.Xor a) where
  function :: forall b. (Xor a -> b) -> Xor a :-> b
function = (Xor a -> a) -> (a -> Xor a) -> (Xor a -> b) -> Xor a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Xor a -> a
forall a. Xor a -> a
Bits.getXor a -> Xor a
forall a. a -> Xor a
Bits.Xor

instance Function a => Function (Bits.Iff a) where
  function :: forall b. (Iff a -> b) -> Iff a :-> b
function = (Iff a -> a) -> (a -> Iff a) -> (Iff a -> b) -> Iff a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Iff a -> a
forall a. Iff a -> a
Bits.getIff a -> Iff a
forall a. a -> Iff a
Bits.Iff
#endif

instance Function FormatSign where
  function :: forall b. (FormatSign -> b) -> FormatSign :-> b
function = (FormatSign -> Bool)
-> (Bool -> FormatSign) -> (FormatSign -> b) -> FormatSign :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\FormatSign
x -> case FormatSign
x of FormatSign
SignPlus -> Bool
True; FormatSign
_ -> Bool
False) (\Bool
b -> if Bool
b then FormatSign
SignPlus else FormatSign
SignSpace)

instance Function FormatAdjustment where
  function :: forall b. (FormatAdjustment -> b) -> FormatAdjustment :-> b
function = (FormatAdjustment -> Bool)
-> (Bool -> FormatAdjustment)
-> (FormatAdjustment -> b)
-> FormatAdjustment :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\FormatAdjustment
x -> case FormatAdjustment
x of FormatAdjustment
LeftAdjust -> Bool
True; FormatAdjustment
_ -> Bool
False) (\Bool
b -> if Bool
b then FormatAdjustment
LeftAdjust else FormatAdjustment
ZeroPad)

instance Function FormatParse where
  function :: forall b. (FormatParse -> b) -> FormatParse :-> b
function = (FormatParse -> (String, Char, String))
-> ((String, Char, String) -> FormatParse)
-> (FormatParse -> b)
-> FormatParse :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap FormatParse -> (String, Char, String)
to (String, Char, String) -> FormatParse
from
    where to :: FormatParse -> (String, Char, String)
to FormatParse
fp = (FormatParse -> String
fpModifiers FormatParse
fp, FormatParse -> Char
fpChar FormatParse
fp, FormatParse -> String
fpRest FormatParse
fp)
          from :: (String, Char, String) -> FormatParse
from (String
a, Char
b, String
c) = String -> Char -> String -> FormatParse
FormatParse String
a Char
b String
c

instance Function FieldFormat where
  function :: forall b. (FieldFormat -> b) -> FieldFormat :-> b
function = (FieldFormat
 -> (Maybe Int, Maybe Int, Maybe FormatAdjustment, Maybe FormatSign,
     Bool, String, Char))
-> ((Maybe Int, Maybe Int, Maybe FormatAdjustment,
     Maybe FormatSign, Bool, String, Char)
    -> FieldFormat)
-> (FieldFormat -> b)
-> FieldFormat :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap FieldFormat
-> (Maybe Int, Maybe Int, Maybe FormatAdjustment, Maybe FormatSign,
    Bool, String, Char)
to (Maybe Int, Maybe Int, Maybe FormatAdjustment, Maybe FormatSign,
 Bool, String, Char)
-> FieldFormat
from
    where to :: FieldFormat
-> (Maybe Int, Maybe Int, Maybe FormatAdjustment, Maybe FormatSign,
    Bool, String, Char)
to FieldFormat
ff = ( FieldFormat -> Maybe Int
fmtWidth FieldFormat
ff
                  , FieldFormat -> Maybe Int
fmtPrecision FieldFormat
ff
                  , FieldFormat -> Maybe FormatAdjustment
fmtAdjust FieldFormat
ff
                  , FieldFormat -> Maybe FormatSign
fmtSign FieldFormat
ff
                  , FieldFormat -> Bool
fmtAlternate FieldFormat
ff
                  , FieldFormat -> String
fmtModifiers FieldFormat
ff
                  , FieldFormat -> Char
fmtChar FieldFormat
ff)
          from :: (Maybe Int, Maybe Int, Maybe FormatAdjustment, Maybe FormatSign,
 Bool, String, Char)
-> FieldFormat
from (Maybe Int
a, Maybe Int
b, Maybe FormatAdjustment
c, Maybe FormatSign
d, Bool
e, String
f, Char
g) = Maybe Int
-> Maybe Int
-> Maybe FormatAdjustment
-> Maybe FormatSign
-> Bool
-> String
-> Char
-> FieldFormat
FieldFormat Maybe Int
a Maybe Int
b Maybe FormatAdjustment
c Maybe FormatSign
d Bool
e String
f Char
g

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

instance Function SeekMode where
  function :: forall b. (SeekMode -> b) -> SeekMode :-> b
function = [SeekMode] -> (SeekMode -> b) -> SeekMode :-> b
forall a b. Eq a => [a] -> (a -> b) -> a :-> b
functionElements [SeekMode
AbsoluteSeek, SeekMode
RelativeSeek, SeekMode
SeekFromEnd]

instance Function IOMode where
  function :: forall b. (IOMode -> b) -> IOMode :-> b
function = [IOMode] -> (IOMode -> b) -> IOMode :-> b
forall a b. Eq a => [a] -> (a -> b) -> a :-> b
functionElements [IOMode
ReadMode, IOMode
WriteMode, IOMode
AppendMode, IOMode
ReadWriteMode]

instance Function BufferMode where
  function :: forall b. (BufferMode -> b) -> BufferMode :-> b
function = (BufferMode -> Either Bool (Maybe Int))
-> (Either Bool (Maybe Int) -> BufferMode)
-> (BufferMode -> b)
-> BufferMode :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap BufferMode -> Either Bool (Maybe Int)
to Either Bool (Maybe Int) -> BufferMode
from
    where to :: BufferMode -> Either Bool (Maybe Int)
to BufferMode
NoBuffering = Bool -> Either Bool (Maybe Int)
forall a b. a -> Either a b
Left Bool
True
          to BufferMode
LineBuffering = Bool -> Either Bool (Maybe Int)
forall a b. a -> Either a b
Left Bool
False
          to (BlockBuffering Maybe Int
m) = Maybe Int -> Either Bool (Maybe Int)
forall a b. b -> Either a b
Right Maybe Int
m

          from :: Either Bool (Maybe Int) -> BufferMode
from (Left Bool
True) = BufferMode
NoBuffering
          from (Left Bool
False) = BufferMode
LineBuffering
          from (Right Maybe Int
m)    = Maybe Int -> BufferMode
BlockBuffering Maybe Int
m

instance Function ExitCode where
  function :: forall b. (ExitCode -> b) -> ExitCode :-> b
function = (ExitCode -> Maybe Int)
-> (Maybe Int -> ExitCode) -> (ExitCode -> b) -> ExitCode :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap ExitCode -> Maybe Int
to Maybe Int -> ExitCode
from
    where to :: ExitCode -> Maybe Int
to ExitCode
ExitSuccess = Maybe Int
forall a. Maybe a
Nothing
          to (ExitFailure Int
c) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
c

          from :: Maybe Int -> ExitCode
from Maybe Int
Nothing = ExitCode
ExitSuccess
          from (Just Int
c) = Int -> ExitCode
ExitFailure Int
c

instance Function Version where
  function :: forall b. (Version -> b) -> Version :-> b
function = (Version -> ([Int], [String]))
-> (([Int], [String]) -> Version)
-> (Version -> b)
-> Version :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Version -> ([Int], [String])
to ([Int], [String]) -> Version
from
    where to :: Version -> ([Int], [String])
to (Version [Int]
a [String]
b) = ([Int]
a, [String]
b)
          from :: ([Int], [String]) -> Version
from ([Int]
a, [String]
b) = [Int] -> [String] -> Version
Version [Int]
a [String]
b

#if !defined(__MHS__)
instance Function ByteArray where
  function :: forall b. (ByteArray -> b) -> ByteArray :-> b
function = (ByteArray -> [Word8])
-> ([Word8] -> ByteArray) -> (ByteArray -> b) -> ByteArray :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap ByteArray -> [Word8]
ByteArray -> [Item ByteArray]
forall l. IsList l => l -> [Item l]
Exts.toList [Word8] -> ByteArray
[Item ByteArray] -> ByteArray
forall l. IsList l => [Item l] -> l
Exts.fromList
#endif

#if MIN_VERSION_base(4,16,0)
instance Function a => Function (Solo a) where
  function :: forall b. (Solo a -> b) -> Solo a :-> b
function = (Solo a -> a) -> (a -> Solo a) -> (Solo a -> b) -> Solo a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Solo a -> a
forall a. Solo a -> a
getSolo a -> Solo a
forall a. a -> Solo a
mkSolo
#endif

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

#if !MIN_VERSION_base(4,15,0)
instance Function a => Function (Semigroup.Option a) where
  function = functionMap Semigroup.getOption Semigroup.Option
#endif

-- poly instances

instance Function A where
  function :: forall b. (A -> b) -> A :-> b
function = (A -> Integer) -> (Integer -> A) -> (A -> b) -> A :-> b
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 = (B -> Integer) -> (Integer -> B) -> (B -> b) -> B :-> b
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 = (C -> Integer) -> (Integer -> C) -> (C -> b) -> C :-> b
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 = (OrdA -> Integer) -> (Integer -> OrdA) -> (OrdA -> b) -> OrdA :-> b
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 = (OrdB -> Integer) -> (Integer -> OrdB) -> (OrdB -> b) -> OrdB :-> b
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 = (OrdC -> Integer) -> (Integer -> OrdC) -> (OrdC -> b) -> OrdC :-> b
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 = (a -> b) -> a :-> b
forall a b. Function a => (a -> b) -> a :-> b
forall b. (a -> b) -> a :-> b
function ((a -> b) -> a :-> b) -> Gen (a -> b) -> Gen (a :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Gen (a -> b)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: (a :-> b) -> [a :-> b]
shrink    = (b -> [b]) -> (a :-> b) -> [a :-> b]
forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun b -> [b]
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 = ((Rep a Any -> b) -> Rep a Any :-> b)
-> (a -> Rep a Any) -> (Rep a Any -> a) -> (a -> b) -> a :-> b
forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (Rep a Any -> b) -> Rep a Any :-> b
forall a b. (Rep a a -> b) -> Rep a a :-> b
forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. 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 = (U1 a -> ()) -> (() -> U1 a) -> (U1 a -> b) -> U1 a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\U1 a
U1 -> ()) (\() -> U1 a
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 = (((f a, g a) -> b) -> (f a, g a) :-> b)
-> ((:*:) f g a -> (f a, g a))
-> ((f a, g a) -> (:*:) f g a)
-> ((:*:) f g a -> b)
-> (:*:) f g a :-> b
forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (((f a -> g a -> b) -> f a :-> (g a -> b))
-> ((g a -> b) -> g a :-> b)
-> ((f a, g a) -> b)
-> (f a, g a) :-> b
forall a b c.
((a -> b -> c) -> a :-> (b -> c))
-> ((b -> c) -> b :-> c) -> ((a, b) -> c) -> (a, b) :-> c
functionPairWith (f a -> g a -> b) -> f a :-> (g a -> b)
forall (a :: k) b. (f a -> b) -> f a :-> b
forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction (g a -> b) -> g a :-> b
forall (a :: k) b. (g a -> b) -> g a :-> b
forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction) (:*:) f g a -> (f a, g a)
forall {k} {f :: k -> *} {g :: k -> *} {p :: k}.
(:*:) f g p -> (f p, g p)
g (f a, g a) -> (:*:) f g a
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 f p -> g p -> (:*:) f g p
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 = ((Either (f a) (g a) -> b) -> Either (f a) (g a) :-> b)
-> ((:+:) f g a -> Either (f a) (g a))
-> (Either (f a) (g a) -> (:+:) f g a)
-> ((:+:) f g a -> b)
-> (:+:) f g a :-> b
forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (((f a -> b) -> f a :-> b)
-> ((g a -> b) -> g a :-> b)
-> (Either (f a) (g a) -> b)
-> Either (f a) (g a) :-> b
forall a c b.
((a -> c) -> a :-> c)
-> ((b -> c) -> b :-> c) -> (Either a b -> c) -> Either a b :-> c
functionEitherWith (f a -> b) -> f a :-> b
forall (a :: k) b. (f a -> b) -> f a :-> b
forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction (g a -> b) -> g a :-> b
forall (a :: k) b. (g a -> b) -> g a :-> b
forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction) (:+:) f g a -> Either (f a) (g a)
forall {k} {f :: k -> *} {g :: k -> *} {p :: k}.
(:+:) f g p -> Either (f p) (g p)
g Either (f a) (g a) -> (:+:) f g a
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) = f p -> Either (f p) (g p)
forall a b. a -> Either a b
Left f p
x
     g (R1 g p
x) = g p -> Either (f p) (g p)
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) = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x
     h (Right g p
x) = g p -> (:+:) f g p
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 = ((f a -> b) -> f a :-> b)
-> (M1 i c f a -> f a)
-> (f a -> M1 i c f a)
-> (M1 i c f a -> b)
-> M1 i c f a :-> b
forall b c a.
((b -> c) -> b :-> c)
-> (a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMapWith (f a -> b) -> f a :-> b
forall (a :: k) b. (f a -> b) -> f a :-> b
forall {k} (f :: k -> *) (a :: k) b.
GFunction f =>
(f a -> b) -> f a :-> b
gFunction (\(M1 f a
x) -> f a
x) f a -> M1 i c f a
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 = (K1 i a a -> a)
-> (a -> K1 i a a) -> (K1 i a a -> b) -> K1 i a a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(K1 a
x) -> a
x) a -> K1 i a a
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) =
  [ (a :-> (b :-> c)) -> (a, b) :-> c
forall b b c. (b :-> (b :-> c)) -> (b, b) :-> c
pair a :-> (b :-> c)
p' | a :-> (b :-> c)
p' <- ((b :-> c) -> [b :-> c]) -> (a :-> (b :-> c)) -> [a :-> (b :-> c)]
forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun (\b :-> c
q -> (c -> [c]) -> (b :-> c) -> [b :-> c]
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 = (a, b) :-> c
forall a c. a :-> c
Nil
  pair a :-> (b :-> c)
p   = (a :-> (b :-> c)) -> (a, b) :-> c
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 (a :-> c) -> (b :-> c) -> Either a b :-> c
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
forall a c. a :-> c
Nil | Bool -> Bool
not ((b :-> c) -> Bool
forall a b. (a :-> b) -> Bool
isNil b :-> c
q) ] [a :-> c] -> [a :-> c] -> [a :-> c]
forall a. [a] -> [a] -> [a]
++
  [ a :-> c
forall a c. a :-> c
Nil (a :-> c) -> (b :-> c) -> Either a b :-> c
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
q | Bool -> Bool
not ((a :-> c) -> Bool
forall a b. (a :-> b) -> Bool
isNil a :-> c
p) ] [a :-> c] -> [a :-> c] -> [a :-> c]
forall a. [a] -> [a] -> [a]
++
  [ a :-> c
p  (a :-> c) -> (b :-> c) -> Either a b :-> c
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
q' | b :-> c
q' <- (c -> [c]) -> (b :-> c) -> [b :-> c]
forall c a. (c -> [c]) -> (a :-> c) -> [a :-> c]
shrinkFun c -> [c]
shr b :-> c
q ] [a :-> c] -> [a :-> c] -> [a :-> c]
forall a. [a] -> [a] -> [a]
++
  [ a :-> c
p' (a :-> c) -> (b :-> c) -> Either a b :-> c
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
.+. b :-> c
q  | a :-> c
p' <- (c -> [c]) -> (a :-> c) -> [a :-> c]
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 = Either a b :-> c
forall a c. a :-> c
Nil
  a :-> c
p   .+. b :-> c
q   = a :-> c
p (a :-> c) -> (b :-> c) -> Either a b :-> c
forall b c b. (b :-> c) -> (b :-> c) -> Either b b :-> c
:+: b :-> c
q

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

shrinkFun c -> [c]
shr (Table [(a, c)]
xys) =
  [ [(a, c)] -> a :-> c
forall a c. Eq a => [(a, c)] -> a :-> c
table [(a, c)]
xys' | [(a, c)]
xys' <- ((a, c) -> [(a, c)]) -> [(a, c)] -> [[(a, c)]]
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 :: Eq aa => [(aa,cc)] -> (aa :-> cc) -- MicroHs needs this
  table :: forall a c. Eq a => [(a, c)] -> a :-> c
table []  = aa :-> cc
forall a c. a :-> c
Nil
  table [(aa, cc)]
xys = [(aa, cc)] -> aa :-> cc
forall a c. Eq a => [(a, c)] -> a :-> c
Table [(aa, cc)]
xys

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

shrinkFun c -> [c]
shr (Map a -> b
g b -> a
h b :-> c
p) =
  [ (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
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' <- (c -> [c]) -> (b :-> c) -> [b :-> c]
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 = a :-> c
forall a c. a :-> c
Nil
  mapp a -> b
g b -> a
h b :-> c
p   = (a -> b) -> (b -> a) -> (b :-> c) -> a :-> c
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
(Shrunk -> Shrunk -> Bool)
-> (Shrunk -> Shrunk -> Bool) -> Eq Shrunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Shrunk -> Shrunk -> Bool
== :: Shrunk -> Shrunk -> Bool
$c/= :: Shrunk -> Shrunk -> Bool
/= :: 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) = (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
forall a b. (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
Fun ((a -> b) -> (a :-> a) -> a :-> b
forall a b. (a -> b) -> (a :-> a) -> a :-> b
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 (a -> b) -> (a -> a) -> a -> b
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

-- | Create a `Fun` from a function representation and a default value (in case the function
-- is partial).
mkFun :: (a :-> b) -> b -> Fun a b
mkFun :: forall a b. (a :-> b) -> b -> Fun a b
mkFun a :-> b
p b
d = (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
forall a b. (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
Fun (a :-> b
p, b
d, Shrunk
NotShrunk) ((a :-> b) -> b -> a -> b
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 = Fun a b -> a -> b
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
_)    = (a :-> b) -> Maybe b -> String
forall a b. (Show a, Show b) => (a :-> b) -> Maybe b -> String
showFunction a :-> b
p (b -> Maybe b
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 <- Gen (a :-> b)
forall a. Arbitrary a => Gen a
arbitrary
       b
d <- Gen b
forall a. Arbitrary a => Gen a
arbitrary
       Fun a b -> Gen (Fun a b)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a :-> b) -> b -> Fun a b
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) =
    [ (a :-> b) -> b -> Fun a b
forall a b. (a :-> b) -> b -> Fun a b
mkFun a :-> b
p' b
d' | (a :-> b
p', b
d') <- (a :-> b, b) -> [(a :-> b, b)]
forall a. Arbitrary a => a -> [a]
shrink (a :-> b
p, b
d) ] [Fun a b] -> [Fun a b] -> [Fun a b]
forall a. [a] -> [a] -> [a]
++
    [ (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
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 Shrunk -> Shrunk -> Bool
forall a. Eq a => a -> a -> Bool
== Shrunk
NotShrunk ]

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