diff options
Diffstat (limited to 'Haskell-book/16/func/src')
| -rw-r--r-- | Haskell-book/16/func/src/Func.hs | 89 |
1 files changed, 89 insertions, 0 deletions
diff --git a/Haskell-book/16/func/src/Func.hs b/Haskell-book/16/func/src/Func.hs new file mode 100644 index 0000000..920ab80 --- /dev/null +++ b/Haskell-book/16/func/src/Func.hs @@ -0,0 +1,89 @@ +module Func where + +import Test.QuickCheck + +-- class Functor f where +-- fmap :: (a -> b) -> f a -> f b + +newtype Identity a = Identity a deriving (Eq, Show) + +instance Functor Identity where + fmap f (Identity a) = Identity $ f a + +instance Arbitrary a => Arbitrary (Identity a) where + arbitrary = fmap Identity arbitrary + +data Pair a = Pair a a deriving (Eq, Show) + +instance Functor Pair where + fmap f (Pair x y) = Pair (f x) (f y) + +instance Arbitrary a => Arbitrary (Pair a) where + arbitrary = do + x <- arbitrary + y <- arbitrary + return $ Pair x y + +data Two a b = Two a b deriving (Eq, Show) + +instance Functor (Two a) where + fmap f (Two x y) = Two x (f y) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where + arbitrary = do + x <- arbitrary + y <- arbitrary + return $ Two x y + +data Three a b c = Three a b c deriving (Eq, Show) + +instance Functor (Three a b) where + fmap f (Three x y z) = Three x y (f z) + +instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + return $ Three x y z + +data Three' a b = Three' a b b deriving (Eq, Show) + +instance Functor (Three' a) where + fmap f (Three' x y z) = Three' x (f y) (f z) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + return $ Three' x y z + +data Four a b c d = Four a b c d deriving (Eq, Show) + +instance Functor (Four a b c) where + fmap f (Four x y z t) = Four x y z (f t) + +instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) + => Arbitrary (Four a b c d) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + t <- arbitrary + return $ Four x y z t + +data Four' a b = Four' a a a b deriving (Eq, Show) + +instance Functor (Four' a) where + fmap f (Four' x y z t) = Four' x y z (f t) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Four' a b) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + t <- arbitrary + return $ Four' x y z t + +data Trivial = Trivial |
