diff --git a/Control/Monatron/AutoInstances.hs b/Control/Monatron/AutoInstances.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/AutoInstances.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS
+  -XFlexibleInstances
+  -XOverlappingInstances
+#-}
+
+module Control.Monatron.AutoInstances where
+
+import Control.Monatron.MonadT
+
+------------------------------------------------------------------
+instance (Monad m, MonadT t) => Monad (t m) where
+    return = treturn
+    fail   = lift . fail
+    (>>=)  = tbind
+
+instance (Monad m, MonadT t) => Functor (t m) where fmap = liftM
diff --git a/Control/Monatron/AutoLift.hs b/Control/Monatron/AutoLift.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/AutoLift.hs
@@ -0,0 +1,128 @@
+{-# OPTIONS
+  -XFlexibleInstances
+  -XMultiParamTypeClasses
+  -XFunctionalDependencies
+  -XUndecidableInstances
+  -XOverlappingInstances
+#-}
+
+--  -XOverlappingInstances
+
+module Control.Monatron.AutoLift (
+ StateM(..), get,put,
+ WriterM (..), tell,
+ ReaderM(..), ask,local,
+ ExcM(..), throw,handle,
+ ContM(..), callCC,
+ ListM(..), mZero,mPlus,
+ module Control.Monatron.Operations
+) where
+
+import Control.Monatron.Operations
+import Control.Exception (SomeException)
+
+
+------------------------------------------------------------------
+-- State
+class Monad m => StateM z m | m -> z where
+    stateModel :: AlgModel (StateOp z) m
+
+instance Monad m => StateM z (StateT z m) where
+    stateModel = modelStateT
+
+instance (StateM z m, MonadT t) => StateM z (t m) where
+    stateModel = liftAlgModel stateModel
+
+get :: StateM z m => m z
+get = getX stateModel
+
+put :: StateM z m => z -> m ()
+put = putX stateModel
+
+------------------------------------------------------------------
+-- Traces
+class (Monoid z, Monad m) => WriterM z m | m -> z where
+    writerModel :: AlgModel (WriterOp z) m
+
+instance (Monoid z, Monad m) => WriterM z (WriterT z m) where
+    writerModel = modelWriterT
+
+instance (Monoid z, WriterM z m, MonadT t) => WriterM z (t m) where
+    writerModel = liftAlgModel writerModel
+
+tell :: (Monoid z, WriterM z m) => z -> m ()
+tell z = traceX writerModel z
+
+------------------------------------------------------------------
+-- Environments
+class Monad m => ReaderM z m | m -> z where
+    readerModel :: Model (ReaderOp z) m
+
+instance Monad m => ReaderM z (ReaderT z m) where
+    readerModel = modelReaderT
+
+instance (ReaderM z m, Functor m, FMonadT t) => ReaderM z (t m) where
+    readerModel = liftModel readerModel
+
+ask :: ReaderM z m => m z
+ask = askX readerModel
+
+local :: ReaderM z m => (z -> z) -> m a -> m a
+local = localX readerModel
+
+------------------------------------------------------------------
+-- Throw and Handle
+class Monad m => ExcM z m | m -> z where
+    throwModel :: AlgModel (ThrowOp z) m
+    handleModel :: Model (HandleOp z) m
+
+instance Monad m => ExcM z (ExcT z m) where
+    throwModel = modelThrowExcT
+    handleModel = modelHandleExcT
+
+instance ExcM SomeException IO where
+    throwModel  = modelThrowIO
+    handleModel = modelHandleIO
+
+instance (ExcM z m, Functor m, FMonadT t) => ExcM z (t m) where
+    throwModel = liftAlgModel throwModel
+    handleModel = liftModel handleModel
+
+throw :: ExcM z m => z -> m a
+throw = throwX throwModel
+
+handle :: ExcM z m => m a -> (z -> m a) -> m a
+handle = handleX handleModel
+
+------------------------------------------------------------------
+-- callCC operation
+
+class Monad m => ContM r m | m -> r where
+    contModel :: AlgModel (ContOp r) m
+
+instance Monad m => ContM (m r) (ContT r m) where
+    contModel = modelContT
+
+instance (ContM r m, MonadT t) => ContM r (t m) where
+    contModel = liftAlgModel contModel
+
+callCC :: ContM r m => ((a -> r) -> a) -> m a
+callCC = callCCX contModel
+
+------------------------------------------------------------------
+-- MPlus operations
+
+class Monad m => ListM m where
+    listModel :: AlgModel ListOp m
+
+instance Monad m => ListM (ListT m) where
+    listModel = modelListT
+
+instance (ListM m, MonadT t) => ListM (t m) where
+    listModel = liftAlgModel listModel
+
+mZero :: (ListM m) => m a
+mZero = zeroListX listModel
+
+mPlus :: ListM m => m a -> m a -> m a
+mPlus = plusListX listModel
diff --git a/Control/Monatron/Codensity.hs b/Control/Monatron/Codensity.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Codensity.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS -XRank2Types #-}
+
+module Control.Monatron.Codensity (
+ Codensity,
+ codensity,
+ runCodensity
+) where
+
+import Control.Monatron.MonadT
+import Control.Monad.Fix
+import Control.Monatron.AutoInstances()
+
+----------------------------------------------------------
+-- Codensity Monad
+----------------------------------------------------------
+
+newtype Codensity f a = Codensity { 
+      unCodensity :: forall b. (a -> f b) -> f b 
+}
+
+codensity :: (forall b. (a -> f b) -> f b) -> Codensity f a
+codensity = Codensity
+
+runCodensity :: Monad m => Codensity m a -> m a
+runCodensity c = unCodensity c return 
+
+instance MonadT Codensity where
+    lift m        = Codensity (m >>=)
+    c `tbind` f   = Codensity (\k -> unCodensity c (\a -> unCodensity (f a) k))
+
+-- still need to prove that MonadFix laws hold
+instance MonadFix m => MonadFix (Codensity m) where
+    mfix f = Codensity $ \k -> mfix (runCodensity. f) >>= k
+
+------------------------
+
diff --git a/Control/Monatron/IdT.hs b/Control/Monatron/IdT.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/IdT.hs
@@ -0,0 +1,13 @@
+module Control.Monatron.IdT  where 
+
+import Control.Monatron.Monatron
+
+newtype IdT m a = IdT { runIdT :: m a }
+
+instance MonadT IdT where
+    lift         = IdT
+    tbind m f    = IdT $ runIdT m >>= runIdT . f 
+    
+instance FMonadT IdT where
+    tmap' d1 d2 g f       = IdT . f . fmapD d1 g . runIdT
+
diff --git a/Control/Monatron/Monad.hs b/Control/Monatron/Monad.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Monad.hs
@@ -0,0 +1,67 @@
+
+module Control.Monatron.Monad (
+  State, Writer, Reader, Exception, Cont,
+  state,writer,reader,exception,cont,
+  runState, runWriter, runReader, runException, runCont,
+  Id(..), Lift(..)
+) where
+  
+
+import Control.Monatron.Transformer
+import Control.Monad
+import Control.Monad.Fix
+
+newtype Id a   = Id {runId :: a}
+data    Lift a = L  {runLift :: a}
+
+type State s      = StateT s Id
+type Writer w     = WriterT w Id
+type Reader r     = ReaderT r Id
+type Exception x  = ExcT x Id
+type Cont r       = ContT r Id
+
+state :: (s -> (a, s)) -> State s a
+state st = stateT $ \s -> Id $ st s
+
+runState :: s -> State s a -> (a,s)
+runState s = runId. runStateT s
+
+writer :: Monoid w => (a,w) -> Writer w a
+writer = writerT . Id
+
+runWriter :: Monoid w => Writer w a -> (a,w)
+runWriter = runId. runWriterT
+
+reader :: (r -> a) -> Reader r a
+reader e = readerT $ \r -> Id (e r)
+
+runReader :: r -> Reader r a -> a
+runReader r = runId . runReaderT r
+
+exception :: Either x a -> Exception x a
+exception = excT . Id
+
+runException :: Exception x a -> Either x a
+runException = runId. runExcT
+
+cont :: ((a -> r) -> r) -> Cont r a
+cont c = contT $ \k -> Id $ c (runId . k)
+
+runCont :: (a -> r) -> Cont r a  -> r
+runCont k = runId. runContT (Id. k)
+
+instance Monad Id where
+    return  = Id
+    fail    = error
+    m >>= f = f (runId m)
+
+instance Monad Lift where
+  return x  = L x
+  fail x    = error x
+  L x >>= k = k x
+
+instance Functor Id   where fmap = liftM
+instance Functor Lift where fmap = liftM
+
+instance MonadFix Id   where mfix f = let m = f (runId m)   in m
+instance MonadFix Lift where mfix f = let m = f (runLift m) in m
diff --git a/Control/Monatron/MonadT.hs b/Control/Monatron/MonadT.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/MonadT.hs
@@ -0,0 +1,47 @@
+{-# OPTIONS -XRank2Types #-}
+
+module Control.Monatron.MonadT (
+  MonadT(..), FMonadT(..), MMonadT(..), FComp(..), FunctorD(..), tmap, mtmap,
+  module Control.Monad
+) where
+
+import Control.Monad
+
+
+----------------------------------------------------------
+-- Class of monad transformers with 
+-- a lifting of first-order operations
+----------------------------------------------------------
+
+class MonadT t where
+    lift    :: Monad m  => m a -> t m a
+    treturn :: Monad m => a -> t m a
+    treturn =  lift. return
+    tbind   :: Monad m => t m a -> (a -> t m b) -> t m b
+
+newtype FunctorD f = FunctorD {fmapD :: forall a b . (a -> b) -> f a -> f b}
+
+functor :: Functor f => FunctorD f
+functor = FunctorD fmap
+
+class MonadT t => FMonadT t where
+    tmap' :: FunctorD m -> FunctorD n -> (a -> b) -> (forall x. m x -> n x) -> t m a -> t n b
+    
+tmap :: (FMonadT t, Functor m, Functor n) => (forall b. m b -> n b) -> t m a -> t n a
+tmap = tmap' functor functor id
+
+mtmap :: FMonadT t => FunctorD f -> (a -> b) -> t f a -> t f b
+mtmap fd f = tmap' fd fd f id
+
+class FMonadT t => MMonadT t where
+    flift      :: Functor f => f a -> t f a --should coincide with lift!
+    monoidalT  :: (Functor f, Functor g) => t f (t g a) -> t (FComp f g) a 
+
+----------------------------------------
+-- Functor Composition
+----------------------------------------
+      
+newtype (FComp f g) a = Comp {deComp :: (f (g a)) }
+
+instance (Functor f, Functor g) => Functor (FComp f g) where
+    fmap f (Comp fga) = Comp (fmap (fmap f) fga)
diff --git a/Control/Monatron/Monatron.hs b/Control/Monatron/Monatron.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Monatron.hs
@@ -0,0 +1,12 @@
+
+module Control.Monatron.Monatron (
+   module Control.Monatron.Monad,
+   module Control.Monatron.AutoLift,
+   version
+)where
+
+import Control.Monatron.Monad
+import Control.Monatron.AutoLift
+
+version :: (Int,Int,Int)
+version = (0,0,1)
diff --git a/Control/Monatron/Open.hs b/Control/Monatron/Open.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Open.hs
@@ -0,0 +1,52 @@
+{-# OPTIONS -fglasgow-exts -XNoMonomorphismRestriction -XOverlappingInstances #-}
+
+module Control.Monatron.Open where
+
+import Control.Monatron.Monatron
+import Control.Monatron.AutoLift
+
+infixr 9 :+:
+infixr 9 <@>
+
+data (:+:) f g a = Inl (f a) | Inr (g a)
+
+newtype Fix f = In {out :: f (Fix f)}
+
+type Open e f r = (e -> r) -> (f e -> r)
+
+(<@>) :: Open e f r -> Open e g r -> Open e (f :+: g) r
+evalf <@> evalg = \eval e -> 
+  case e of
+    Inl el  -> evalf eval el
+    Inr er  -> evalg eval er       
+    
+fix :: Open (Fix f) f r -> (Fix f -> r)
+fix f =  let this = f this . out 
+         in this
+            
+-- Borrowed from Data types \`a la Carte
+
+class (f :<: g) where
+  inj :: f a -> g a
+ 
+instance Functor f => (:<:) f f where
+  inj = id
+ 
+instance  (Functor g, Functor f) 
+          => (:<:) f (f :+: g) where
+  inj = Inl
+ 
+instance  (Functor g, Functor h, Functor f, f :<: g) 
+          => (:<:) f (h :+: g) where 
+  inj = Inr . inj
+
+inject :: (f :<: g) => f (Fix g) -> Fix g
+inject = In . inj
+
+instance (Functor f, Functor g) => 
+ Functor (f :+: g) where
+  fmap f (Inl x)  = Inl (fmap f x)
+  fmap f (Inr y)  = Inr (fmap f y)
+  
+foldFix :: Functor f => (f a -> a) ->  Fix f -> a
+foldFix f = f . fmap (foldFix f) . out 
diff --git a/Control/Monatron/Operations.hs b/Control/Monatron/Operations.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Operations.hs
@@ -0,0 +1,195 @@
+{-# OPTIONS -XRank2Types #-}
+
+module Control.Monatron.Operations (
+    ExtModel, Model, AlgModel, toAlg, liftModel, liftAlgModel, liftExtModel,                         
+    StateOp(..), modelStateT, getX, putX,
+    ReaderOp(..), modelReaderT, askX, inEnvX,  localX,     
+    WriterOp(..), modelWriterT, traceX,
+    ThrowOp(..),HandleOp(..), modelThrowExcT, modelHandleExcT,
+    modelThrowIO, modelHandleIO, throwX, handleX,
+    ContOp(..), modelContT, callccX, callCCX, abortX,
+    StepOp(..), stepX, modelStepT,
+    ListOp(..), modelListT, zeroListX, plusListX,
+    module Control.Monatron.Transformer
+) where
+
+import Control.Monatron.Codensity
+import Control.Monatron.Transformer
+import qualified Control.Exception as IO (throwIO,catch,SomeException)
+
+-------------------------------------------------
+-- Models and Standard Liftings
+-------------------------------------------------
+      
+type ExtModel f g m  = forall a. f (m (g a)) -> m a
+type Model f m       = forall a. f (m a) -> m a
+type AlgModel f m    = forall a. f a -> m a
+
+toAlg       :: (Functor f, Monad m) => Model f m -> AlgModel f (Codensity m)
+toAlg op t  = codensity $ \k ->  op (fmap k t)
+
+liftModel     :: (Functor f, Monad m, Functor m, FMonadT t, Monad (t (Codensity m))) => 
+                 Model f m -> Model f (t m)
+liftModel op  = tmap runCodensity . join . lift . toAlg op . fmap (tmap lift)
+
+liftAlgModel     :: (MonadT t, Monad m, Functor f) => AlgModel f m -> AlgModel f (t m)
+liftAlgModel op  = lift . op
+
+liftExtModel     ::  (  Functor f, Functor g, Monad m, Functor m, 
+                        MMonadT t, Functor (t f), Functor (t m)) => 
+                     ExtModel f g m -> ExtModel f g (t m)
+liftExtModel op  =    tmap (op . fmap deComp . deComp) . 
+                      monoidalT . flift . fmap  (monoidalT . fmap flift) 
+      
+----------------------
+-- State Operations
+----------------------
+      
+data StateOp s a = Get (s -> a) | Put s a
+
+instance Functor (StateOp s) where
+    fmap f (Get g)    = Get (f . g)
+    fmap f (Put s a)  = Put s (f a)
+
+modelStateT            :: Monad m => AlgModel (StateOp s) (StateT s m)
+modelStateT (Get g)    = stateT (\s -> return (g s, s))
+modelStateT (Put s a)  = stateT (\_ -> return (a, s))
+
+getX     :: Monad m => AlgModel (StateOp s) m -> m s
+getX op  = op $ Get id
+
+putX       :: Monad m => AlgModel (StateOp s) m -> s -> m ()
+putX op s  = op $ Put s ()
+      
+----------------------
+-- Reader Operations
+----------------------
+      
+data ReaderOp s a = Ask (s -> a) | InEnv s a
+
+instance Functor (ReaderOp s) where
+    fmap f (Ask g)      = Ask (f . g)
+    fmap f (InEnv s a)  = InEnv s (f a)
+
+modelReaderT              :: Monad m => Model (ReaderOp s) (ReaderT s m)
+modelReaderT (Ask g)      = readerT (\s -> runReaderT s (g s))
+modelReaderT (InEnv s a)  = readerT (\_ -> runReaderT s a)
+
+askX     :: Monad m => Model (ReaderOp s) m -> m s
+askX op  = op $ Ask return
+
+inEnvX         :: Monad m => Model (ReaderOp s) m -> s -> m a -> m a
+inEnvX op s m  = op $ InEnv s m 
+      
+--derived
+
+localX :: Monad m => Model (ReaderOp z) m -> (z -> z) -> m a -> m a
+localX m f t = do z <- askX m
+                  inEnvX m (f z) t
+
+------------------------
+-- Exception Operations
+------------------------
+      
+data ThrowOp x a   = Throw x
+data HandleOp x a  = Handle a (x -> a)
+
+instance Functor (ThrowOp x) where
+    fmap _ (Throw x) = Throw x
+
+instance Functor (HandleOp x) where
+    fmap f (Handle a h) = Handle (f a) (f . h)
+
+modelThrowExcT            :: Monad m => AlgModel (ThrowOp x) (ExcT x m)
+modelThrowExcT (Throw x)  = excT (return (Left x))
+
+modelHandleExcT               :: Monad m => Model (HandleOp x) (ExcT x m)
+modelHandleExcT (Handle m h)  = excT (runExcT m >>= \exa -> case  exa of
+                                                Left x  -> runExcT (h x)
+                                                Right a -> return (Right a))
+
+modelThrowIO              :: AlgModel (ThrowOp IO.SomeException) IO
+modelThrowIO (Throw x)    = IO.throwIO x
+
+modelHandleIO               :: Model (HandleOp IO.SomeException) IO
+modelHandleIO (Handle m h)  = IO.catch m h
+
+throwX       :: Monad m => AlgModel (ThrowOp x) m -> x -> m a
+throwX op x  = op $ Throw x
+
+handleX         :: Monad m => Model(HandleOp x) m -> m a -> (x -> m a) -> m a
+handleX op m h  = op $ Handle m h
+      
+------------------------
+-- Writer Operations
+------------------------
+      
+data WriterOp w a = Trace w a
+
+instance Functor (WriterOp w) where
+    fmap f (Trace w a) = Trace w (f a)
+
+modelWriterT :: (Monad m, Monoid w) => AlgModel (WriterOp w) (WriterT w m)
+modelWriterT (Trace w a)  = writerT (return (a,w))
+
+traceX       :: (Monad m) => AlgModel (WriterOp w) m -> w -> m ()
+traceX op w  = op $ Trace w ()
+      
+--------------------------
+-- Continuation Operations
+--------------------------
+      
+data ContOp r a = Abort r | CallCC ((a -> r) -> a)
+
+instance Functor (ContOp r) where
+    fmap _ (Abort r)      = Abort r
+    fmap f (CallCC k)     = CallCC (\c -> f (k (c . f)))
+
+modelContT             :: Monad m => AlgModel (ContOp (m r)) (ContT r m)
+modelContT (Abort mr)  = contT $ \_ -> mr
+modelContT (CallCC k)  = contT $ \c -> c (k c)
+
+abortX       :: Monad m => AlgModel (ContOp r) m -> r -> m a
+abortX op r  = op (Abort r)
+
+callCCX       :: Monad m => AlgModel (ContOp r) m -> ((a -> r) -> a) -> m a
+callCCX op f  = op (CallCC f)
+
+callccX       :: Monad m => AlgModel (ContOp r) m -> ((a -> m b) -> m a) -> m a
+callccX op f  =  join $ callCCX op (\k -> f (\x -> abortX op (k (return x))))  
+      
+--------------------------
+-- Step Operations
+--------------------------
+      
+newtype StepOp f x = StepOp (f x)
+
+instance (Functor f) => Functor (StepOp f) where 
+    fmap h (StepOp fa) = StepOp (fmap h fa)
+
+modelStepT              :: (Functor f, Monad m) => Model (StepOp f) (StepT f m)
+modelStepT (StepOp fa)  = stepT (return (Right fa))
+
+stepX     :: (Monad m) => Model (StepOp f) m -> f (m x) -> m x
+stepX op  = op . StepOp 
+  
+--------------------------
+-- List Operations
+--------------------------
+      
+data ListOp a = ZeroList | PlusList a a
+
+instance Functor ListOp where
+    fmap _ ZeroList        = ZeroList
+    fmap f (PlusList a b)  = PlusList (f a) (f b)
+
+modelListT               :: Monad m => AlgModel ListOp (ListT m)
+modelListT ZeroList        = emptyL
+modelListT (PlusList t u)  = appendL (return t) (return u)
+
+zeroListX         :: Monad m => AlgModel ListOp m -> m a
+zeroListX op      = op ZeroList
+
+plusListX         :: Monad m => AlgModel ListOp m -> m a -> m a -> m a
+plusListX op t u  = join $ op (PlusList t u)
+
diff --git a/Control/Monatron/Transformer.hs b/Control/Monatron/Transformer.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Transformer.hs
@@ -0,0 +1,285 @@
+
+module Control.Monatron.Transformer (
+  StateT, stateT, runStateT,
+  WriterT, writerT, runWriterT,
+  ReaderT, readerT, runReaderT,
+  ExcT, excT, runExcT,
+  ContT, contT, runContT,
+  StepT, stepT, runStepT, caseStepT, unfoldStepT,
+  ListT, listT, runListT, foldListT, collectListT, emptyL, appendL,
+--  module Monatron.Operations,
+  module Control.Monatron.MonadT,
+  module Data.Monoid
+) where
+
+--import Monatron.Operations
+import Control.Monad.Fix
+import Control.Monatron.MonadT
+-- for Writer
+import Data.Monoid
+-- for Error (and Reader?)
+--import Monatron.Codensity
+import Control.Monatron.AutoInstances()
+
+--State Monad Transformer
+newtype StateT s m a = S { unS :: s -> m (a,s) }
+
+stateT ::  (s -> m (a, s)) -> StateT s m a
+stateT = S
+
+runStateT :: s -> StateT s m a -> m (a,s) 
+runStateT s m = unS m s
+
+instance MonadT (StateT s) where
+    lift  m           = S $ \s -> m >>= \a -> return (a,s)
+    m `tbind` k       = S $ \s -> unS m s >>= \ ~(a, s') -> unS (k a) s'
+
+instance (MonadFix m) => MonadFix (StateT s m) where
+  mfix f  = S $ \s -> mfix (runStateT s . f . fst)
+
+instance FMonadT (StateT s) where
+    tmap' d1 _d2 g f (S m) = S (f . fmapD d1 (\(x,s) -> (g x,s)) . m)
+
+instance MMonadT (StateT s) where
+    flift t          = S (\s -> fmap (\a -> (a,s)) t)
+    monoidalT (S t)  = S (\s -> Comp $ fmap (\(S t',s') -> t' s') (t s))
+
+{-
+-- StateT implementation of operations
+withStateT :: Monad m => Fop (With s) (StateT s m)
+withStateT (With f)  = S $ \s  -> runStateT s (f s)
+
+makeStateT :: Monad m => Fop (Make s) (StateT s m)
+makeStateT (Make (m,s)) = S $ \_ -> runStateT s m
+-}
+
+--------------------------------------------------------------
+-- Writer Monad Transformer
+
+newtype WriterT w m a = W {unW :: m (a,w) } 
+
+writerT :: (Monoid w, Monad m) => m (a,w) -> WriterT w m a
+writerT = W
+
+runWriterT :: (Monoid w) => WriterT w m a -> m (a,w)
+runWriterT = unW
+                 
+instance Monoid w => MonadT (WriterT w) where  
+    tbind (W m) f  = W (do  (a,w) <- m
+                            (a',w') <- unW (f a)
+                            return (a',w `mappend` w'))
+    lift m         = W (liftM (\a -> (a,mempty)) m)
+
+{-
+instance (MonadFix m, Monoid w) => MonadFix (WriterT w m) where
+    mfix f = W $ mfix (unW. f) 
+-}
+
+instance Monoid w => FMonadT (WriterT w) where
+    tmap' d1 _d2 g f  = W . f . fmapD d1 (\(x,s) -> (g x,s)) . unW
+
+instance Monoid w => MMonadT (WriterT w) where
+    flift t          = W (fmap (\a -> (a,mempty)) t)
+    monoidalT (W t)  = W $ Comp $  fmap (\(W t',w) -> 
+                                   fmap (\(a,w') -> (a,w `mappend` w')) t') $ t
+
+{-
+-- WriterT implementation of operations
+withWriterT :: (Monoid w, Monad m) => Fop (With w) (WriterT w m)
+withWriterT (With c)   = W $ S $ \w -> runWriterT (c w)
+
+
+makeWriterT :: (Monoid w, Monad m) => Fop (Make w) (WriterT w m)
+makeWriterT (Make (m, w)) = writerT $ runWriterT m >>= \(a,w') -> 
+                            return (a,w' `mappend` w)
+-}
+--------------------------------------------------------------
+-- Reader Monad Transformer
+newtype ReaderT s m a = R { unR :: s -> m a }
+
+runReaderT      :: s -> ReaderT s m a -> m a
+runReaderT s m  = unR m s
+
+instance MonadT (ReaderT s) where
+    tbind m k  = R (\s -> unR m s >>= \a -> unR (k a) s)
+    lift  m    = R (\_ -> m)
+
+readerT :: Monad m => (e -> m a) -> ReaderT e m a
+readerT = R
+
+{-
+instance (MonadFix m) => MonadFix (ReaderT w m) where
+    mfix f = R $ mfix (unR. f) 
+-}
+
+instance FMonadT (ReaderT s) where
+    tmap' d1 _d2 g f (R m) = R (f . fmapD d1 g . m)
+
+instance MMonadT (ReaderT s) where
+    flift t          = R (\_ -> t)
+    monoidalT (R t)  = R (\s -> Comp $ fmap (($ s) . unR) (t s))
+
+{-
+-- ReaderT implementation of operations
+makeReaderT :: Monad m => Fop (Make e) (ReaderT e m)
+makeReaderT = R . makeStateT . fmap unR
+
+withReaderT :: Monad m => Fop (With e) (ReaderT e m)
+withReaderT = R . withStateT . fmap unR
+-}
+--------------------------------------------------------------
+-- Exceptions Monad Transformer
+newtype ExcT x m a = X {unX :: m (Either x a)}
+
+excT :: Monad m => m (Either x a) -> ExcT x m a
+excT = X
+
+runExcT :: Monad m => ExcT x m a -> m (Either x a)
+runExcT = unX
+--
+instance (MonadFix m) => MonadFix (ExcT x m) where
+  mfix f  = X $ mfix (unX . f . fromRight)
+    where fromRight (Right a) = a
+          fromRight _         = error "ExceptionT: mfix looped."
+
+
+--
+instance MonadT (ExcT x) where
+    lift m           = X (liftM Right m)
+    (X m) `tbind` f  = X (do a <- m
+                             case a of
+                                Left x  -> return (Left x)
+                                Right b -> unX (f b))
+
+
+instance FMonadT (ExcT x) where
+    tmap' d1 _d2 g f  = X . f . fmapD d1 func . unX where
+      func (Left x)   = Left x
+      func (Right y)  = Right (g y)
+
+{-
+-- internal operations
+throwExcT :: Monad m => Fop (Throw x) (ExcT x m)
+throwExcT (Throw x) = X $ return (Left x)
+--
+handleExcT :: Monad m => Fop (Handle x) (ExcT x m)
+handleExcT (Handle (m, h)) = X (unX m >>= \exa ->
+                                    case exa of
+                                      Left x  -> unX (h x)
+                                      Right a -> return (Right a))
+
+-- Instances of the operations for IO exceptions
+throwIO :: Fop (Throw IO.SomeException) IO
+throwIO (Throw x) = IO.throwIO x
+--
+handleIO :: Fop (Handle IO.SomeException) IO
+handleIO (Handle (m, h)) = IO.catch m h
+-}
+
+--------------------------------------------------------------
+-- Continuations Monad Transformer
+
+newtype ContT r m a = C {unC :: (a -> m r) -> m r}
+
+runContT :: (a -> m r) -> ContT r m a -> m r
+runContT = flip unC
+
+contT ::  ((a -> m r) -> m r) -> ContT r m a
+contT = C
+
+instance MonadT (ContT r) where
+    lift m = C (m >>=)
+    m `tbind` k   = C $ \c -> unC m (\a -> unC (k a) c)
+
+{-
+callCCContT :: Monad m => Fop (CallCC (m r)) (ContT r m)
+callCCContT (CallCC f) = C $ \k -> unC (f (\a -> unC a k)) k
+
+abortContT :: Monad m => Fop (Abort (m r)) (ContT r m)
+abortContT (Abort mr) = C $ \_ -> mr
+-}
+--------------------------------------------------------------
+-- List monad transformer
+
+data LSig f a b = NilT b
+                | ConsT a (f a)
+
+newtype ListT m a = L {unL :: m (LSig (ListT m) a ())}
+
+runListT :: ListT m a -> m (LSig (ListT m) a ())
+runListT = unL
+
+listT :: m (LSig (ListT m) a ()) -> ListT m a
+listT = L
+
+emptyL :: Monad m => ListT m a
+emptyL = L $ return $ NilT ()
+
+appendL :: Monad m=> ListT m a -> ListT m a -> ListT m a
+appendL (L m1) (L m2) = L $ do
+            l <- m1
+            case l of
+              NilT ()    -> m2
+              ConsT a l1 -> return (ConsT a (appendL l1 (L m2)))
+
+foldListT :: Monad m => (a -> m b -> m b) -> m b -> ListT m a -> m b
+foldListT c n (L m) = do l <- m 
+                         case l of 
+                            NilT ()    -> n 
+                            ConsT a l1 -> c a (foldListT c n l1)
+
+collectListT :: Monad m => ListT m a -> m [a]
+collectListT lt = foldListT (\a m -> m >>= return. (a:)) (return []) lt
+
+instance MonadT ListT where
+    lift m       = L $ liftM (`ConsT` emptyL) m
+    m `tbind` f  = L $ foldListT (\a l -> unL $ f a `appendL` L l)
+                                 (return $ NilT ())
+                                 m
+
+instance FMonadT ListT where
+    tmap' d1 d2 g t (L m) = L $ t $ fmapD d1 (\lsig  -> case lsig of
+                                            NilT ()    -> NilT ()
+                                            ConsT a l  -> ConsT (g a) (tmap' d1 d2 g t l)) m
+
+{-
+mZeroListT :: Monad m => Fop MZero (ListT m)
+mZeroListT (MZero _) = emptyL 
+
+mPlusListT :: (Monad m) => Fop MPlus (ListT m)
+mPlusListT (MPlus (a, b)) = appendL a b
+-}
+------------------------------------------------
+-- Step Monad Transformer
+------------------------------------------------
+      
+newtype StepT f m x = T {runT :: m (Either x (f (StepT f m x)))}
+
+stepT :: m (Either x (f (StepT f m x))) -> StepT f m x
+stepT = T
+
+runStepT :: StepT f m x ->  m (Either x (f (StepT f m x)))
+runStepT = runT
+
+{-
+instance (Functor f, Monad m) => Monad (StepT f m) where
+    return  = treturn
+    (>>=)   = tbind
+-}
+
+--instance (Functor f, Monad m) => Functor (StepT f m) where fmap = liftM
+
+caseStepT            ::  (Functor f, Monad m) =>  
+                         (a -> StepT f m x) -> (f (StepT f m a) -> StepT f m x)
+                         -> StepT f m a -> StepT f m x
+caseStepT v c (T m)  = T (m >>= either (runT . v) (runT . c))
+
+unfoldStepT      :: (Functor f, Monad m) => (y -> m (Either x (f y))) -> y -> StepT f m x
+unfoldStepT k y  = T (liftM (fmap (fmap (unfoldStepT k))) (k y))
+
+instance (Functor f) => MonadT (StepT f) where
+    tbind t f  = caseStepT f (T . return . Right . fmap (`tbind` f)) t
+    lift       = T . liftM Left
+
+instance (Functor f) => FMonadT (StepT f) where
+    tmap' d1 d2 g t (T m) = T (t (fmapD d1 (either (Left . g) (Right . fmap (tmap' d1 d2 g t))) m))
diff --git a/Control/Monatron/Zipper.hs b/Control/Monatron/Zipper.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/Zipper.hs
@@ -0,0 +1,118 @@
+{-# OPTIONS -fglasgow-exts -XNoMonomorphismRestriction #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Control.Monatron.Zipper where
+
+import Control.Monatron.MonadT ()
+import Control.Monatron.IdT ()
+import Control.Monatron.AutoLift 
+import Control.Monatron.Operations
+import Control.Monatron.Monad ()
+-- import Monatron.AutoInstances()
+
+newtype (t1 :> (t2 :: (* -> *) -> * -> *)) m a = L { runL :: t1 (t2 m) a }
+
+runZipper :: (t1 :> t2) m a -> t1 (t2 m) a
+runZipper = runL
+
+zipper :: t1 (t2 m) a -> (t1 :> t2) m a 
+zipper = L
+
+-- * Relative Navigation
+
+-- | shift focus to left
+leftL  :: (t1 :> t2) m a -> t1 (t2 m) a
+leftL   = runL
+
+-- | shift focus to right
+rightL :: t1 (t2 m) a -> (t1 :> t2) m  a
+rightL  =  L 
+
+-- The zipper is an FMonadT and a MonadT
+
+instance (FMonadT t1, FMonadT t2) => FMonadT (t1 :> t2) where
+     tmap' d1 d2 g f       = 
+       L . tmap' (FunctorD (mtmap d1)) (FunctorD (mtmap d2)) g (tmap' d1 d2 id f) . runL
+
+instance (MonadT t1, MonadT t2) => MonadT (t1 :> t2) where
+     lift         = L . lift . lift
+     tbind m f    = L $ runL m >>= runL . f
+     
+-- Instances of the zipper for the various effects
+     
+instance (Monad m, MonadT t1, MonadT t2, StateM z (t2 m)) => StateM z ((t1 :> t2) m) where
+     stateModel = L . liftAlgModel stateModel
+     
+instance (WriterM z (t2 m), MonadT t1, Monad m, MonadT t2) => WriterM z ((t1 :> t2) m) where
+     writerModel  = L . liftAlgModel writerModel
+
+instance (ReaderM z (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ReaderM z ((t1 :> t2) m) where     
+      readerModel  = L . liftModel readerModel . fmap runL 
+      
+instance (ExcM z (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ExcM z ((t1 :> t2) m) where
+    throwModel  = L . liftAlgModel throwModel
+    handleModel = L . liftModel handleModel . fmap runL 
+    
+instance (ContM r (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ContM r ((t1 :> t2) m) where
+    contModel = L . liftAlgModel contModel
+    
+instance (ListM (t2 m), FMonadT t1, FMonadT t2, Functor (t2 m), Monad m) => 
+         ListM ((t1 :> t2) m) where
+    listModel = L . liftAlgModel listModel
+    
+-- runtest :: (((),Int),Int)
+-- runtest = runState 0 $ runStateT 0 $ runZipper (put 3)
+
+-- Views and masks; could be in a different file
+    
+data (:><:) m n = View {
+  to    :: forall a . m a -> n a,
+  from  :: forall a . n a -> m a
+}
+
+i :: m :><: m
+i = View id id
+
+o :: (Monad m, MonadT t1, MonadT t2) => t1 (t2 m) :><: (t1 :> t2) m
+o = View rightL leftL
+
+vlift  :: (FMonadT t, Functor m, Functor n) 
+       => (m :><: n) -> (t m :><: t n)
+vlift v  = View (tmap (to v)) (tmap (from v))
+
+
+hcomp :: (n :><: o) -> (m :><: n) -> (m :><: o)
+v2 `hcomp` v1  =  View  (to v2 . to v1) (from v1 . from v2)
+
+vcomp  :: (Functor m1, Functor m2, FMonadT t) 
+       => (t m2 :><: m3) -> (m1 :><: m2) -> (t m1 :><: m3)
+v2 `vcomp` v1  = v2 `hcomp` (vlift v1)
+
+-- program :: StateM Int m => m Int
+-- program = put 3 >> return 4
+
+-- t = runState 1 $ runStateT 0 $ runIdT $ runIdT $ view i program
+
+r :: Monad m => StateT s m :><: ReaderT s m
+r  = View  {
+  to    = \s -> readerT (\e -> liftM fst $ runStateT e s),
+  from  = \e -> stateT (\s ->  liftM (\x -> (x,s)) $ runReaderT s e)
+}
+
+stateIso  :: Monad m => (s1 -> s2) -> (s2 -> s1) -> StateT s1 m :><: StateT s2 m
+stateIso f fm1 = View  {to = iso f fm1, from = iso fm1 f } where 
+  iso g h m = stateT $ \s2 -> do  (a, s1) <- runStateT (h s2) m
+                                  return (a, g s1)
+                                  
+getv :: StateM s n => (m :><: n) -> m s
+getv var  = from var get 
+
+putv :: StateM s n => (m :><: n) -> s -> m ()
+putv var  = from var . put
diff --git a/Control/Monatron/ZipperExamples.hs b/Control/Monatron/ZipperExamples.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monatron/ZipperExamples.hs
@@ -0,0 +1,83 @@
+{-# OPTIONS -XTypeOperators -XFlexibleContexts #-}
+
+module Control.Monatron.ZipperExamples where
+
+import Control.Monatron.Monatron
+import Control.Monatron.Zipper
+import Control.Monatron.Open
+
+-- Don't we need a bidirectional view to implement this combinator?
+
+fmask :: (m :><: n) -> Open e f (n a) -> Open e f (m a)
+fmask v evalf eval = from v . evalf (to v . eval)
+
+type Env = [(String,Int)]
+
+type Count = Int
+
+data Mem e  = Store e | Retrieve
+
+type Reg    = Int
+ 
+evalMem2  :: (StateM Reg (t m), StateM Count m, MonadT t) 
+             => Open e Mem (t m Int)
+evalMem2 eval (Store e) =
+  do  count <- lift $ get
+      lift $ put (count + 1)
+      n <- eval e
+      put n
+      return n
+evalMem2 eval Retrieve = lift $ get
+
+type M4 =  StateT Reg (StateT Env (ExcT String (StateT Count Id)))
+
+data Lit a = Lit Int
+data Var a = Var String
+data Add e = Add e e
+
+instance Functor Lit where
+  fmap _ (Lit l)      = Lit l
+
+instance Functor Var where
+  fmap _ (Var v)      = Var v
+
+instance Functor Add where
+  fmap f (Add e1 e2)  = Add (f e1) (f e2)
+  
+instance Functor Mem where
+  fmap f (Store x)  = Store (f x)
+  fmap f Retrieve   = Retrieve
+  
+lit :: (Lit :<: g)  => Int -> Fix g
+lit l      = inject (Lit l)
+
+var :: (Var :<: g)  => String -> Fix g 
+var v      = inject (Var v)
+
+add :: (Add :<: g)  => Fix g -> Fix g -> Fix g
+add e1 e2  = inject (Add e1 e2)
+
+store :: (Mem :<: g) => Fix g -> Fix g
+store e = inject (Store e)
+
+retrieve :: (Mem :<: g) => Fix g
+retrieve = inject Retrieve
+
+type Expr3  = Fix (Mem :+: Var :+: Lit)
+
+evalLit _ (Lit n) = return n 
+
+evalVar _ (Var v) = do env <- get
+                       case lookup v env of
+                         Just n -> return n
+                         Nothing -> throw "undefined variable"
+
+eval4 :: Expr3 -> M4 Int
+eval4 = fix  (    fmask (i `vcomp` o `vcomp` o) evalMem2
+             <@>  fmask o evalVar  
+             <@>  evalLit)
+        
+test = runId $ runStateT 0 $ handleExc $ runStateT [] $ runStateT 0 $ eval4 (store (lit 3))
+
+handleExc :: Monad m => ExcT a m b -> m b
+handleExc = liftM (either (error "Error!") id) . runExcT
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
diff --git a/Monatron.cabal b/Monatron.cabal
new file mode 100644
--- /dev/null
+++ b/Monatron.cabal
@@ -0,0 +1,34 @@
+name:         Monatron
+version:      0.3
+license:      BSD3
+license-file: LICENSE
+author:       Mauro Jaskelioff
+maintainer:   mauro@fceia.unr.edu.ar
+category:     Control
+synopsis:     Monad transformer library with uniform liftings
+description:
+	An extensible monad transformer library with uniform liftings, a 
+	fairly portable core, and option of explicit naming of liftings.
+	See http:\/\/www.fceia.unr.edu.ar\/~mjj\/Monatron\/ for more information.
+
+	The monad zipper allows modular composition of components with Monatron effects.
+        It is a contribution of Bruno Oliveira and Tom Schrijvers.
+        See http:\/\/www.cs.kuleuven.be\/~toms\/Haskell\/ for more information.
+build-type: Simple
+ghc-options: -Wall
+exposed-modules:
+	Control.Monatron.MonadT
+	Control.Monatron.AutoInstances
+	Control.Monatron.Operations
+	Control.Monatron.Codensity
+	Control.Monatron.Transformer
+	Control.Monatron.Monad
+	Control.Monatron.AutoLift
+	Control.Monatron.Monatron
+	Control.Monatron.IdT
+	Control.Monatron.Zipper
+	Control.Monatron.Open
+	Control.Monatron.ZipperExamples
+build-depends: base >= 2 && < 3
+extensions: 
+	Rank2Types
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
