1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
|
{-# LANGUAGE AllowAmbiguousTypes #-}
module Legacy.Spec.Product ( laws, uniqLaws )
where
import Legacy.Clothes(F, G)
import Data.Barbie(FunctorB(..), ProductB(..))
import Data.Functor.Product(Product(Pair))
import Data.Typeable(Typeable, Proxy(..), typeRep)
import Test.Tasty(TestTree)
import Test.Tasty.QuickCheck(Arbitrary(..), testProperty, (===))
laws
:: forall b
. ( ProductB b
, Eq (b F), Eq (b G)
, Show (b F), Show (b G)
, Arbitrary (b F), Arbitrary (b G)
, Typeable b
)
=> TestTree
laws
= testProperty (show (typeRep (Proxy :: Proxy b))) $ \l r ->
bmap first (bprod l r) == (l :: b F) &&
bmap second (bprod l r) == (r :: b G)
where
first (Pair a _) = a
second (Pair _ b) = b
uniqLaws
:: forall b
. ( ProductB b
, Eq (b Maybe)
, Show (b F), Show (b Maybe)
, Arbitrary (b F)
, Typeable b
)
=> TestTree
uniqLaws
= testProperty (show (typeRep (Proxy :: Proxy b))) $ \b ->
bmap (const Nothing) (b :: b F) === buniq Nothing
|