Identity Functor

{-# LANGUAGE ViewPatterns #-}

module FuncInstances where

import Test.QuickCheck
import Test.QuickCheck.Function

functorIdentity :: (Functor f, Eq (f a)) => f a -> Bool
functorIdentity f = fmap id f == f

functorCompose :: (Eq (f c), Functor f) => (a -> b) -> (b -> c) -> f a -> Bool
functorCompose f g x = (fmap g (fmap f x)) == (fmap (g . f) x)

functorCompose' :: (Eq (f c), Functor f) =>
                     f a
                  -> Fun a b
                  -> Fun b c
                  -> Bool
functorCompose' x (Fun _ f) (Fun _ g) =
  (fmap (g . f) x) == (fmap g . fmap f $ x)

newtype Identity a = Identity a
  deriving (Show, Eq)

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Arbitrary a => Arbitrary (Identity a) where
  arbitrary = do
    x <- arbitrary
    return $ Identity x

type IdentityId = Identity Int -> Bool
type IdentityComp = (Int -> Int) -> (Int -> Int) -> Identity Int -> Bool

type IdentityIntToInt = Fun (Identity Int) (Identity Int)
type IdentityIntFC = [Identity Int] -> IdentityIntToInt -> IdentityIntToInt -> Bool

main :: IO ()
main = do
  quickCheck (functorIdentity :: IdentityId)
  quickCheck (functorCompose' :: IdentityIntFC)