今更QuickCheckの練習してた

gistfile1.hs

{-# LANGUAGE DeriveFunctor #-}
module Main where
import Test.QuickCheck
import Prelude (($), (.), id)
import Prelude (Integer, Bool)
import Prelude (IO(..), putStrLn)
import Prelude (Show(..), Read(..), Eq(..))
import Prelude (Functor(..), Monad(..))
import Control.Monad
import Control.Applicative

-- Id monad
newtype Id a = Id { runId :: a } deriving (Show, Read, Eq, Functor)
instance Monad Id where
  m >>= k = k $ runId m
  return = Id
instance Arbitrary a => Arbitrary (Id a) where
  arbitrary = return Id <*> arbitrary 

--Maybe monad
data Maybe a = Just a | Nothing deriving (Show, Read, Eq, Functor)
instance Monad Maybe where
  (Just m) >>= k = k m
  Nothing >>= _ = Nothing
  return x = Just x
instance Arbitrary a => Arbitrary (Maybe a) where
  arbitrary = do
    x <- arbitrary 
    elements [Nothing, Just x]

-- Either monad
data Either a b = Left a | Right b deriving (Show, Read, Eq, Functor)
instance Monad (Either a)  where
  (Right m) >>= k = k m
  (Left x) >>= _ = Left x
  return x = Right x
instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
  arbitrary = do
    x <- arbitrary 
    y <- arbitrary 
    elements [Left x, Right y]

-- Test for monad laws
main :: IO ()
main = do
  putStrLn "Id Monad"
  quickCheck (propMonadLaw1 :: Id Integer -> Bool)
  quickCheck (propMonadLaw2 :: Id Integer -> Bool)
  quickCheck (propMonadLaw3 :: Id (Id (Id Integer)) -> Bool)

  putStrLn "Maybe Monad"
  quickCheck (propMonadLaw1 :: Maybe Integer -> Bool)
  quickCheck (propMonadLaw2 :: Maybe Integer -> Bool)
  quickCheck (propMonadLaw3 :: Maybe (Maybe (Maybe Integer)) -> Bool)

  putStrLn "Either Monad"
  quickCheck (propMonadLaw1 :: Either Integer Integer -> Bool)
  quickCheck (propMonadLaw2 :: Either Integer Integer -> Bool)
  quickCheck (propMonadLaw3 :: Either Integer (Either Integer (Either Integer Integer)) -> Bool)

propMonadLaw1 :: (Eq (m Integer), Functor m, Monad m) => m Integer -> Bool
propMonadLaw1 xs = (join . return) xs == id xs

propMonadLaw2 :: (Eq (m Integer), Functor m, Monad m) => m Integer -> Bool
propMonadLaw2 xs = (join . fmap return) xs == id xs

propMonadLaw3 :: (Eq (m Integer), Functor m, Monad m) => m (m (m Integer)) -> Bool
propMonadLaw3 xs = (join . join) xs == (join . fmap join) xs