File: Product.hs

package info (click to toggle)
haskell-barbies 2.0.5.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 460 kB
  • sloc: haskell: 5,483; makefile: 3
file content (45 lines) | stat: -rw-r--r-- 1,021 bytes parent folder | download
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