Example code for: Introduction to Category Theory with Applications in Computer Science

example.hs

{-# LANGUAGE NoImplicitPrelude,KindSignatures #-}

-- Joe Jevnik
-- 2014.4.12
-- Examples to go with my abstract algebra final paper.

-- | Lets hide the functions we will be writing ourselves.
import Prelude hiding (Functor,Monad,(>>=),return,fmap)

-- | Our haskell functor class.
class Functor (f :: * -> *) where
    fmap :: (a -> b) -> f a -> f b

-- | Our haskell monad class.
class Functor m => Monad m where
    return :: a -> m a
    (>>=)  :: m a -> (a -> m b) -> m b

-- | The join operator.
join :: Monad m => m (m a) -> m a
join a = a >>= id

-- | Let's make a functor from Hask to Lst.
instance Functor [] where
    fmap _ []     = []
    fmap f (n:ns) = f n : fmap f ns

-- | Why stop with functors, let's go from Lst to Lst
instance Monad [] where
    return n   = [n]
    (>>=) ns f = concat . fmap f $ ns

-- | This function shows the first monad law.
monadLawOne :: Monad m => m (m (m a)) -> (m a,m a)
monadLawOne ns = (join . fmap join $ ns,join . join $ ns)

-- | This function shows the second monad law.
monadLawTwo :: Monad m => m a -> (m a, m a, m a)
monadLawTwo ns = (join . fmap return $ ns,join . return $ ns,id ns)

-- | This function shows the third monad law.
monadLawThree :: (Monad m, Monad f) => (a -> b) -> a -> (m b, f b)
monadLawThree f ns = (return . f $ ns,fmap f . return $ ns)

-- | This function shows the fourth monad law.
monadLawFour :: Monad f => (a -> b) -> f (f a) -> (f b, f b)
monadLawFour f ns = (join . fmap (fmap f) $ ns,fmap f . join $ ns)

-- | IO is a monad too!
main :: IO ()
main = putStr "fmap (+ 1) [1,2,3]      = "
       >> putStrLn (show $ fmap (+ 1) [1,2,3])
       >> putStr "return 5 :: [Int]       = "
       >> putStrLn (show $ (return 5 :: [Int]))
       >> putStr "[1,2,3] >>= replicate 3 = "
       >> putStrLn (show $ [1,2,3] >>= replicate 3)
       >> putStrLn ("Does monad law 1 hold for our list monad? "
                    ++ if let (a,b) = monadLawOne [[[1,2,3],[2,3,4]]
                                                  ,[[5,6,7],[7,8,9]]]
                          in a == b
                         then "Yes, of course!"
                         else "No, what did you do!?")
       >> putStrLn ("Does monad law 2 hold for our list monad? "
                    ++ if let (a,b,c) = monadLawTwo [1,2,3]
                          in a == b && b == c
                         then "For sure!"
                         else "No, what idiot programmed this?")
       >> putStrLn ("Does monad law 3 hold for our list monad? "
                    ++ if let (a,b) = monadLawThree (+ 1) 1
                          in and $ zipWith (==) a b
                         then "Oui!"
                         else "No es bien!")
       >> putStrLn ("Does monad law 4 hold for our list monad? "
                    ++ if let (a,b) = monadLawFour (+ 1) [[1,2,3],[4,5,6]]
                          in and $ zipWith (==) a b
                         then "Yes! Yes! A thousand times, yes!"
                         else "Did you break it again?")