{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Test.QuickCheck.HigherOrder.Internal.Constructible where
import Data.Functor.Identity
import qualified Data.Monoid as Monoid
import Test.QuickCheck (Arbitrary(..), Function, CoArbitrary, Fun)
class (Arbitrary (Repr a), Show (Repr a)) => Constructible a where
type Repr a
type instance Repr a = a
fromRepr :: Repr a -> a
data Constructed a = Constructed (Repr a) a
pattern Construct :: a -> Constructed a
pattern $mConstruct :: forall r a. Constructed a -> (a -> r) -> (Void# -> r) -> r
Construct a <- Constructed _ a
mkConstructed :: Constructible a => Repr a -> Constructed a
mkConstructed :: Repr a -> Constructed a
mkConstructed Repr a
r = Repr a -> a -> Constructed a
forall a. Repr a -> a -> Constructed a
Constructed Repr a
r (Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr Repr a
r)
instance Constructible a => Arbitrary (Constructed a) where
arbitrary :: Gen (Constructed a)
arbitrary = (Repr a -> Constructed a) -> Gen (Repr a) -> Gen (Constructed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr a -> Constructed a
forall a. Constructible a => Repr a -> Constructed a
mkConstructed Gen (Repr a)
forall a. Arbitrary a => Gen a
arbitrary
shrink :: Constructed a -> [Constructed a]
shrink (Constructed Repr a
r a
_) = (Repr a -> Constructed a) -> [Repr a] -> [Constructed a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr a -> Constructed a
forall a. Constructible a => Repr a -> Constructed a
mkConstructed (Repr a -> [Repr a]
forall a. Arbitrary a => a -> [a]
shrink Repr a
r)
instance Constructible a => Show (Constructed a) where
showsPrec :: Int -> Constructed a -> ShowS
showsPrec Int
n (Constructed Repr a
r a
_) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Constructed " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Repr a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Repr a
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _"
instance (CoArbitrary a, Function a, Show a, Constructible b) => Constructible (Fun a b) where
type Repr (Fun a b) = Fun a (Repr b)
fromRepr :: Repr (Fun a b) -> Fun a b
fromRepr = (Repr b -> b) -> Fun a (Repr b) -> Fun a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr b -> b
forall a. Constructible a => Repr a -> a
fromRepr
instance Constructible a => Constructible (Identity a) where
type Repr (Identity a) = Repr a
fromRepr :: Repr (Identity a) -> Identity a
fromRepr = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (Repr a -> a) -> Repr a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr
instance (Constructible a, Constructible b) => Constructible (a, b) where
type Repr (a, b) = (Repr a, Repr b)
fromRepr :: Repr (a, b) -> (a, b)
fromRepr (a, b) = (Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr Repr a
a, Repr b -> b
forall a. Constructible a => Repr a -> a
fromRepr Repr b
b)
instance (Constructible a, Constructible b) => Constructible (Either a b) where
type Repr (Either a b) = Either (Repr a) (Repr b)
fromRepr :: Repr (Either a b) -> Either a b
fromRepr (Left a) = a -> Either a b
forall a b. a -> Either a b
Left (Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr Repr a
a)
fromRepr (Right b) = b -> Either a b
forall a b. b -> Either a b
Right (Repr b -> b
forall a. Constructible a => Repr a -> a
fromRepr Repr b
b)
instance Constructible a => Constructible (Maybe a) where
type Repr (Maybe a) = Maybe (Repr a)
fromRepr :: Repr (Maybe a) -> Maybe a
fromRepr = (Repr a -> a) -> Maybe (Repr a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr
instance Constructible a => Constructible [a] where
type Repr [a] = [Repr a]
fromRepr :: Repr [a] -> [a]
fromRepr = (Repr a -> a) -> [Repr a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr
instance Constructible Integer where fromRepr :: Repr Integer -> Integer
fromRepr = Repr Integer -> Integer
forall a. a -> a
id
instance Constructible Int where fromRepr :: Repr Int -> Int
fromRepr = Repr Int -> Int
forall a. a -> a
id
instance Constructible Word where fromRepr :: Repr Word -> Word
fromRepr = Repr Word -> Word
forall a. a -> a
id
instance Constructible Double where fromRepr :: Repr Double -> Double
fromRepr = Repr Double -> Double
forall a. a -> a
id
instance Constructible Char where fromRepr :: Repr Char -> Char
fromRepr = Repr Char -> Char
forall a. a -> a
id
instance Constructible () where fromRepr :: Repr () -> ()
fromRepr = Repr () -> ()
forall a. a -> a
id
instance Constructible Bool where fromRepr :: Repr Bool -> Bool
fromRepr = Repr Bool -> Bool
forall a. a -> a
id
instance Constructible Ordering where fromRepr :: Repr Ordering -> Ordering
fromRepr = Repr Ordering -> Ordering
forall a. a -> a
id
instance Constructible a => Constructible (Monoid.Sum a) where
type Repr (Monoid.Sum a) = Monoid.Sum (Repr a)
fromRepr :: Repr (Sum a) -> Sum a
fromRepr = a -> Sum a
forall a. a -> Sum a
Monoid.Sum (a -> Sum a) -> (Sum (Repr a) -> a) -> Sum (Repr a) -> Sum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repr a -> a
forall a. Constructible a => Repr a -> a
fromRepr (Repr a -> a) -> (Sum (Repr a) -> Repr a) -> Sum (Repr a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum (Repr a) -> Repr a
forall a. Sum a -> a
Monoid.getSum