blob: e36ec3360c6b9756ae598813e20597bf916b1a72 (
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
33
34
35
36
37
38
39
40
|
module ZipList where
import Control.Applicative
import List
import Test.QuickCheck
import Test.QuickCheck.Checkers
take' :: Int -> List a -> List a
take' _ Nil = Nil
take' 0 _ = Nil
take' n (Cons x xs) = Cons x $ take' (n - 1) xs
newtype ZipList' a =
ZipList' (List a)
deriving (Eq, Show)
instance Eq a => EqProp (ZipList' a) where
xs =-= ys = xs' `eq` ys'
where xs' = let (ZipList' l) = xs
in take' 3000 l
ys' = let (ZipList' l) = ys
in take' 3000 l
instance Functor ZipList' where
fmap f (ZipList' xs) = ZipList' $ fmap f xs
instance Monoid a => Monoid (ZipList' a) where
mempty = pure mempty
mappend = liftA2 mappend
instance Applicative ZipList' where
pure f = ZipList' $ repeat
where repeat = Cons f repeat
(ZipList' fs) <*> (ZipList' xs) = ZipList' $ applicative fs xs
where applicative Nil _ = Nil
applicative _ Nil = Nil
applicative (Cons f fs) (Cons x xs) = Cons (f x) $ applicative fs xs
instance Arbitrary a => Arbitrary (ZipList' a) where
arbitrary = ZipList' <$> arbitrary
|
