{-# LANGUAGE Rank2Types, TypeOperators #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Functor.Transform
-- Copyright   :  2004 Dave Menendez
-- License     :  BSD3
-- 
-- Maintainer  :  dan.doel@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (rank-2 polymorphism, infix type constructors)
--
-- Description
-----------------------------------------------------------------------------

module Control.Functor.Transform
  ( module Control.Functor
  , (:>)
  , funcTrans
  , transFunc
  , (.>)
  ) where

import Control.Functor

{-
Let F,G: C -> D be functors. Then t: F -> G is a natural transformation from
F to G iff:
	1. forall a in Ob(C). t[a] in D[F(a),G(a)]
	2. forall f in C[a,b]. t[b] . F(f) = G(f) . t[a]

Thus, a transformation t must satisfy:
	t . fmap f = fmap f . t
for any f
-}

infix 1 :>

type f :> g = forall a. f a -> g a

{-
maybeToList :: Maybe :> []
listToMaybe :: [] :> Maybe
-}

transFunc :: (Functor k) => f :> g -> k `O` f :> k `O` g
transFunc t = Comp . fmap t . deComp

funcTrans :: f :> g -> f `O` h :> g `O` h
funcTrans t = Comp . t . deComp


(.>) :: (Functor k) => h :> k -> f :> g -> h `O` f :> k `O` g
s .> t = Comp . fmap t . s . deComp