Advertisement
Guest User

Untitled

a guest
Jul 31st, 2019
86
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# Language InstanceSigs #-}
  2.  
  3. import Data.Monoid
  4. import Test.QuickCheck
  5. import Test.QuickCheck.Checkers
  6. import Test.QuickCheck.Classes
  7.  
  8.  
  9. newtype ZipList' a = ZipList' [a]
  10.     deriving (Eq, Show)
  11.  
  12. instance Eq a => EqProp (ZipList' a) where
  13.    xs =-= ys = xs' `eq` ys' where
  14.        xs' = let (ZipList' l) = xs
  15.            in take 3000 l
  16.        ys' = let (ZipList' l) = ys
  17.            in take 3000 l
  18.  
  19. instance Semigroup (ZipList' a) where
  20.     (<>) :: ZipList' a -> ZipList' a -> ZipList' a
  21.    (<>) (ZipList' x) (ZipList' y) = ZipList' $ x <> y
  22.  
  23. instance Monoid (ZipList' a) where
  24.    mempty :: ZipList' a
  25.     mempty = ZipList' []
  26.  
  27. instance Functor ZipList' where
  28.     fmap :: (a -> b) -> ZipList' a -> ZipList' b
  29.     fmap f (ZipList' x) = ZipList' $ f <$> x
  30.    
  31. instance Applicative ZipList' where
  32.    pure :: a -> ZipList' a
  33.     pure x = ZipList' [x]
  34.  
  35.    (<*>) :: ZipList' (a -> b) -> ZipList' a -> ZipList' b
  36.     (<*>) (ZipList' []) _ = mempty
  37.    (<*>) (ZipList' [f]) x = f <$> x
  38.     (<*>) (ZipList' (f:fs)) (ZipList' (x:xs)) = pure (f x) <> ((ZipList' fs) <*> (ZipList' xs))
  39.  
  40. instance (Arbitrary a) => Arbitrary (ZipList' a) where
  41.    arbitrary :: Gen (ZipList' a)
  42.     arbitrary = ZipList' <$> arbitrary
  43.  
  44.  
  45. main :: IO ()
  46. main = do
  47.    quickBatch $ monoid (undefined :: ZipList' (Int, String, Int))
  48.     quickBatch $ applicative (undefined :: ZipList' (Int, String, Int))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement