-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Functor
-- Copyright   :  2004 Dave Menendez
-- License     :  public domain
-- 
-- Maintainer  :  zednenem@psualum.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Functor composition, standard functors, and more.
--
-- Note: declares functor instance for @((,) a)@
--
-----------------------------------------------------------------------------

module Control.Functor
  (
  -- * Unary functors
  -- ** Composition
    O(..)
  , lComp
  , rComp
  
  -- ** Basic instances
  -- *** Id
  , Id(..)
  
  -- *** Unit
  , Unit(..)
  
  -- *** Const
  , Const(..)
  
  -- * Binary functors
  , Bifunctor(..)
  
  -- * Trinary functors
  , Trifunctor(..)
  ) where

infixr 2 `O`

{-|
Functor composition.

(Note: Some compilers will let you write @f \`O\` g@ rather than @O f g@;
we'll be doing so here for readability.)

Functor composition is associative, so @f \`O\` (g \`O\` h)@ and @(f \`O\` g) \`O\` h@
are equivalent. The functions 'lComp' and 'rComp' convert between the two.
(Operationally, they are equivalent to @id@. Their only purpose is to affect
the type system.)
-}
newtype (O f g) a = Comp { deComp :: f (g a) }

instance (Functor f, Functor g) => Functor (O f g) where
  fmap f = Comp . fmap (fmap f) . deComp

lComp :: (Functor f) => (O f (O g h)) a -> (O (O f g) h) a
lComp = Comp . Comp . fmap deComp . deComp

rComp :: (Functor f) => (O (O f g) h) a -> (O f (O g h)) a
rComp = Comp . fmap Comp . deComp . deComp

{-|
The identity functor (or a reasonable facsimile thereof).
-}

newtype Id a = Id { unId :: a } deriving (Show)

instance Functor ((,) a) where
  fmap f (x,y) = (x, f y)

instance Functor Id where
  fmap f     = Id . f . unId

instance Monad Id where
  return     = Id
  Id x >>= k = k x

{-|
The unit functor.

(Note: this is not the same as @()@. In fact, 'Unit' is the
fixpoint of @()@.)
-}
data Unit a = Unit deriving (Show)

instance Functor Unit where
  fmap f _    = Unit
instance Monad Unit where
  return _    = Unit
  _ >>= _     = Unit

{-|
Constant functors. Essentially the same as 'Unit', except that they also
carry a value.
-}
data Const t a = Const { unConst :: t } deriving (Show)

instance Functor (Const t) where
  fmap f (Const t) = Const t

{-| 
A type constructor which takes two arguments and an associated map function.

Informally, @Bifunctor f@ implies @Functor (f a)@ with @fmap = bimap id@.
-}
class Bifunctor f where
  bimap :: (a -> c) -> (b -> d) -> (f a b -> f c d)

instance Bifunctor (,) where
  bimap f g (x,y) = (f x, g y)

instance Bifunctor Either where
  bimap f g (Left x)  = Left (f x)
  bimap f g (Right x) = Right (g x)

{-
instance (Trifunctor f) => Bifunctor (f a) where
  bimap = trimap id
-}
{-|
A type constructor which takes three arguments and an associated map function.

Informally, @Trifunctor f@ implies @Bifunctor (f a)@ with @bimap = trimap id@.
-}

class Trifunctor f where
  trimap :: (a -> a') -> (b -> b') -> (c -> c') -> (f a b c -> f a' b' c')

instance Trifunctor (,,) where
  trimap f g h (x,y,z) = (f x, g y, h z)