Skip to content

Instantly share code, notes, and snippets.

@JonathanLorimer
Created May 29, 2019 19:29
Show Gist options
  • Save JonathanLorimer/3c816d90393bd1b335cdc3e5c212a1fc to your computer and use it in GitHub Desktop.
Save JonathanLorimer/3c816d90393bd1b335cdc3e5c212a1fc to your computer and use it in GitHub Desktop.
module FunctorInstances where
import Test.QuickCheck
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 = Identity <$> arbitrary
data Pair a = Pair a a
deriving (Eq, Show)
instance Functor Pair where
fmap f (Pair a b) = Pair (f a) (f b)
instance (Arbitrary a) => Arbitrary (Pair a) where
arbitrary = do
a <- arbitrary
Pair a <$> arbitrary
data Two a b = Two a b
deriving (Eq, Show)
instance Functor (Two a) where
fmap f (Two a b) = Two a (f b)
instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
arbitrary = do
a <- arbitrary
Two a <$> arbitrary
data Three a b c = Three a b c
deriving (Eq, Show)
instance Functor (Three a b) where
fmap f (Three a b c) = Three a b (f c)
instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where
arbitrary = Three <$> arbitrary <*> arbitrary <*> arbitrary
data Three' a b = Three' a b b
deriving (Eq, Show)
instance Functor (Three' a) where
fmap f (Three' a b b') = Three' a (f b) (f b')
instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where
arbitrary = Three' <$> arbitrary <*> arbitrary <*> arbitrary
data Four a b c d = Four a b c d
deriving (Eq, Show)
instance Functor (Four a b c) where
fmap f (Four a b c d) = Four a b c (f d)
instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (Four a b c d) where
arbitrary = Four <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
data Four' a b c = Four' a b c c
deriving (Eq, Show)
instance Functor (Four' a b) where
fmap f (Four' a b c c') = Four' a b (f c) (f c')
instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Four' a b c) where
arbitrary = Four' <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment