module Functor where

import Prelude hiding (Functor, fmap, (<$>))

class Functor (t :: * -> *) where
    fmap :: (a -> b) -> t a -> t b

infixl 4 <$> -- Same as default precedence and associativity
(<$>) :: Functor t => (a -> b) -> t a -> t b
(<$>) = fmap

instance Functor Maybe where
    fmap :: (a -> b) -> Maybe a -> Maybe b
    fmap f Nothing  = Nothing
    fmap f (Just x) = Just $ f x

instance Functor [] where
 -- fmap :: (a -> b) -> [] a -> [] b
    fmap :: (a -> b) -> [a] -> [b]
    fmap = map

instance Functor ((,) a) where
 -- fmap :: (b -> b') -> (,) a b -> (,) a b'
    fmap :: (b -> b') -> (a, b) -> (a, b')
    fmap f (a, b) = (a, f b)

instance Functor (Either a) where
    fmap :: (b -> b') -> Either a b -> Either a b'
    fmap f (Left a)  = Left a
    fmap f (Right b) = Right $ f b

instance Functor ((->) t) where
 -- fmap :: (a -> b) -> ((->) t) a -> ((->) t) b
    fmap :: (a -> b) -> (t -> a) -> (t -> b)
 -- fmap f g = \t -> f (g t)
 -- fmap f g = f . g
    fmap     = (.)

newtype Box a =
  Box { unbox :: a }

instance Functor Box where
    fmap :: (a -> b) -> Box a -> Box b
 -- fmap f (Box a) = Box (f a)
 -- fmap f box     = Box (f (unbox box))
 -- fmap f box     = (Box . f . unbox) box
    fmap f         = Box . f . unbox

newtype AssocList k v =
  BoxAssocList { unboxAssocList :: [(k, v)] }

instance Functor (AssocList k) where
 -- fmap :: (a -> b) -> (AssocList k) a -> (AssocList k) b
    fmap :: (a -> b) -> AssocList k a -> AssocList k b
 -- fmap f (BoxAssocList kvs) = BoxAssocList $ map (fmap f) kvs
 -- fmap f box = BoxAssocList $ map (fmap f) (unboxAssocList box)
 -- fmap f box = BoxAssocList $ map (fmap f) . unboxAssocList $ box
    fmap f     = BoxAssocList . map (fmap f) . unboxAssocList

newtype Compose f g x =
  Compose { getCompose :: f (g x) }

instance (Functor f, Functor g) => Functor (Compose f g) where
    fmap :: (a -> b) -> Compose f g a -> Compose f g b
 -- fmap f (Compose x) = Compose (fmap (fmap f) x)
    fmap f             = Compose . fmap (fmap f) . getCompose

type AssocList' k v =
  Compose [] ((,) k) v