mucking-about.hs

module Functor
    ( Functor
    , lift
    , apply
    , map
    , Monad
    , join
    , flatMap

    , Maybe(..)
    , Either(..)
    ) where

import Prelude ((++), (.), Show(..))

class Functor f where
  lift :: a -> f a

  apply :: f (a -> b) -> f a -> f b

  map :: (a -> b) -> f a -> f b
  map = apply . lift

class (Functor f) => Monad f where
  join :: f (f a) -> f a

  return :: a -> f a
  return = lift

  flatMap :: (a -> f b) -> f a -> f b
  flatMap f = join . map f


-- Maybe

data Maybe a = Nothing | Just a deriving Show

instance Functor Maybe where
  lift f = Just f

  apply (Just f) (Just v) = Just (f v)
  apply _ _ = Nothing

instance Monad Maybe where
  join (Just (Just a)) = Just a
  join _ = Nothing


-- Either

data Either a b = Left a | Right b deriving Show

instance Functor (Either a) where
  lift f = Right f

  apply (Right f) (Right v) = Right (f v)
  apply (Left e) _ = Left e
  apply _ (Left e) = Left e

instance Monad (Either a) where
  join (Right (Right v)) = Right v
  join (Right (Left e)) = Left e
  join (Left e) = Left e


-- List

instance Functor [] where
  lift f = [f]

  apply [] _ = []
  apply _ [] = []
  apply (f : []) (a : as) = (f a) : (map f as)
  apply (f : fs) list = (map f list) ++ (apply fs list)

instance Monad [] where
  join [] = []
  join ([] : bs) = join bs
  join ((a : as) : bs) = a : (join (as : bs))