summaryrefslogtreecommitdiff
path: root/Haskell-book/21/instances/src/SkiFree.hs
blob: 70e87dc8d7b832b12b75c28a17a2d4dbaf45e740 (plain)
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
{-# LANGUAGE FlexibleContexts #-}

module SkiFree where

import Test.QuickCheck
import Test.QuickCheck.Checkers

data S n a = S (n a) a deriving (Eq, Show)

instance ( Functor n
         , Arbitrary (n a)
         , Arbitrary a)
  => Arbitrary (S n a) where
      arbitrary = S <$> arbitrary <*> arbitrary

--instance ( Applicative n
--         , Testable (n Property)
--         , EqProp a)
--  => EqProp (S n a) where
--    (S x y) =-= (S p q) =
--        (property $ (=-=) <$> x <*> p) .&. (y =-= q)
instance (Eq (n a), Eq a) => EqProp (S n a) where
    (=-=) = eq

instance Functor n => Functor (S n) where
    fmap f (S x y) = S (fmap f x) (f y)

instance Foldable n => Foldable (S n) where
    foldMap f (S n a) = mappend (foldMap f n) (f a)

instance Traversable n => Traversable (S n) where
    traverse f (S x y) = S <$> (traverse f x) <*> (f y)