diff --git a/lib/Control/Monad.hm b/lib/Control/Monad.hm
index 6d56ae61..50c0a3b1 100644
--- a/lib/Control/Monad.hm
+++ b/lib/Control/Monad.hm
@@ -42,10 +42,19 @@ module Control.Monad
   , module Data.Functor
   , unsafePerformIO
   , replApply
+  , class Biapplicative
+  , bipure
+  , biapply
+  , (<<*>>)
+  , class Bimonad
+  , bibind
+  , bijoin
   ) where
 
-import Data.Functor (class Functor, map, (<$>))
+import Data.Function (identity)
+import Data.Functor (class Functor, map, (<$>), class Bifunctor, bimap, (<<$>>))
 import Data.Unit (Unit, unit)
+import Data.Tuple (fst, snd)
 
 -----------------------------------------------------------------------------
 -- | Applicative typeclass
@@ -221,9 +230,7 @@ unless :: forall m. Monad m => Boolean -> m () -> m ()
 unless b m = if b then pure () else m
 
 join :: forall m a. Monad m => m (m a) -> m a
-join mma = do
-  ma <- mma
-  ma
+join x = x >>= identity
 
 filterM :: forall m a. Monad m => (a -> m Boolean) -> [a] -> m [a]
 filterM f [] = pure []
@@ -238,4 +245,30 @@ foldM f i [x|xs] = do
   r <- f i x
   foldM f r xs
 
+class Bifunctor f => Biapplicative f where
+  bipure :: forall a b. a -> b -> f a b
+  biapply :: forall a b c d.
+    f (a -> b) (c -> d) -> f a c -> f b d
 
+infixl 4 biapply as <<*>>
+
+instance Biapplicative Tuple2 where
+  bipure x y = (x, y)
+  biapply (f, g) (x, y) = (f x, g y)
+
+class (Biapplicative m, Biapplicative n) => Bimonad m n where
+  bibind :: forall a b c d. (m a b, n a b) -> ((a -> m c d), (b -> n c d)) -> (m c d, n c d)
+
+bijoin :: forall m n a b. Bimonad m n =>
+  (m (m a b) (n a b), n (m a b) (n a b)) -> (m a b, n a b)
+bijoin p = bibind p (identity, identity)
+
+infixl 4 bibind as >>==
+
+bijoin_ :: forall a b. (Tuple2 (Tuple2 a b) (Tuple2 a b), Tuple2 (Tuple2 a b) (Tuple2 a b)) -> (Tuple2 a b, Tuple2 a b)
+bijoin_ = bimap fst snd
+instance Bimonad Tuple2 Tuple2 where
+  bibind (mab, nab) (f, g) = bijoin_ ((bimap f g, bimap f g) <<*>> (mab, nab))
+
+bilift :: forall f a b c d. Biapplicative f => (a -> b) -> (c -> d) -> f a c -> f b d
+bilift f g = biapply (bipure f g)
diff --git a/lib/Control/Monad/Cont/Class.hm b/lib/Control/Monad/Cont/Class.hm
new file mode 100644
index 00000000..4779f276
--- /dev/null
+++ b/lib/Control/Monad/Cont/Class.hm
@@ -0,0 +1 @@
+module Control.Monad.Cont.Class where
diff --git a/lib/Control/Monad/Cont/Cont.hm b/lib/Control/Monad/Cont/Cont.hm
new file mode 100644
index 00000000..e0bda2a3
--- /dev/null
+++ b/lib/Control/Monad/Cont/Cont.hm
@@ -0,0 +1,17 @@
+module Control.Monad.Cont.Cont where
+
+import Data.Function
+import Control.Monad.Identity
+
+newtype ContT r m a = ContT ((a -> m r) -> m r)
+unCont :: forall r m a.
+  ContT r m a -> ((a -> m r) -> m r)
+unCont (ContT x) = x
+
+runConT :: forall r m a.
+  ContT r m a -> (a -> m r) -> m r
+runConT (ContT x) k = x k
+
+
+
+type Cont r a = ContT r Identity a
diff --git a/lib/Control/Monad/Error/Either.hm b/lib/Control/Monad/Error/Either.hm
new file mode 100644
index 00000000..fe52c2df
--- /dev/null
+++ b/lib/Control/Monad/Error/Either.hm
@@ -0,0 +1,32 @@
+module Control.Monad.Error.Either where
+
+import Data.Function (($))
+import Data.Either (Either(..), either)
+import Control.Monad (class Applicative, class Monad, bind, pure, (<*>), (>>=))
+import Data.Functor (class Functor, map, (<$>))
+import Control.Monad.Trans (class MonadTrans)
+
+data EitherT e m a = EitherT (m (Either e a))
+runEitherT :: forall e m a. EitherT e m a -> m (Either e a)
+runEitherT (EitherT x) = x
+
+eitherT :: forall m a b c. Monad m =>
+  (a -> m c) -> (b -> m c) -> EitherT a m b -> m c
+eitherT f g x = runEitherT x >>= either f g
+
+mapEitherT :: forall m n e e' a b.
+  (m (Either e a) -> n (Either e' b)) -> EitherT e m a -> EitherT e' n b
+mapEitherT f x = EitherT (f (runEitherT x))
+
+instance Functor f => Functor (EitherT e f) where
+  map f e = EitherT $ map f <$> runEitherT e
+
+instance Applicative f => Applicative (EitherT e f) where
+  pure x = EitherT $ pure $ Right x
+  apply f x = EitherT $ pure (<*>) <*> (runEitherT f) <*> (runEitherT x)
+
+instance Monad m => Monad (EitherT e m) where
+  bind x k = EitherT $ bind (runEitherT x) (either (\l -> pure (Left l)) (\v -> runEitherT (k v)))
+
+instance MonadTrans (EitherT e) where
+  lift x = EitherT (map Right x)
diff --git a/lib/Control/Monad/Gen/Class.hm b/lib/Control/Monad/Gen/Class.hm
new file mode 100644
index 00000000..a2c5aadb
--- /dev/null
+++ b/lib/Control/Monad/Gen/Class.hm
@@ -0,0 +1 @@
+module Control.Monad.Gen.Class where
diff --git a/lib/Control/Monad/Gen/Gen.hm b/lib/Control/Monad/Gen/Gen.hm
new file mode 100644
index 00000000..43ab859f
--- /dev/null
+++ b/lib/Control/Monad/Gen/Gen.hm
@@ -0,0 +1,57 @@
+module Control.Monad.Gen.Gen where
+
+import Control.Monad.Identity
+import Control.Monad.Trans
+import Control.Monad.State.State
+import Control.Monad.State.Class
+import Control.Monad.Reader.Reader
+import Control.Monad.Reader.Class
+import Data.Functor
+import Control.Monad
+import Data.Function
+import Data.Enum
+
+newtype Succ a = Succ (a -> a)
+unSucc :: forall a. Succ a -> a -> a
+unSucc (Succ x) = x
+
+newtype GenT e m a = GenT (ReaderT (Succ e) (StateT e m) a)
+unGenT :: forall e m a. GenT e m a -> ReaderT (Succ e) (StateT e m) a
+unGenT (GenT x) = x
+
+instance Functor f => Functor (GenT e f) where
+  map f x = GenT $ ReaderT \r -> ST \s -> (map $ mapSnd f)
+    let ReaderT x' = unGenT x
+        ST xs = x' r
+    in xs s
+
+instance (Functor f, Monad f) => Applicative (GenT e f) where
+  pure x = GenT (pure x)
+  apply (GenT f) (GenT x) = GenT $ f <*> x
+
+instance Monad m => Monad (GenT e m) where
+  bind (GenT x) k = GenT $ x >>= \a -> unGenT (k a)
+
+instance MonadPlus m => MonadPlus (GenT e m) where
+  mzero = GenT mzero
+  mplus (GenT m) (GenT n) = GenT (mplus m n)
+
+instance MonadPlus m => Alternative (GenT e m) where
+  empty = mzero
+  append = mplus
+
+type Gen e = GenT e Identity
+
+instance MonadTrans (GenT e) where
+  lift x = GenT $ lift $ lift x
+
+instance MonadState s m => MonadState s (GenT e m) where
+  get = GenT $ lift $ lift get
+  put x = GenT $ lift $ lift $ put x
+
+instance MonadReader r m => MonadReader r (GenT e m) where
+  ask = GenT $ lift ask
+  local f x = GenT $ ask >>= \s -> lift $ local f $ unReaderT (unGenT x) s
+
+enumSucc :: forall a. Enum a => Succ a
+enumSucc = Succ succ
diff --git a/lib/Control/Monad/Identity.hm b/lib/Control/Monad/Identity.hm
new file mode 100644
index 00000000..d6559fe7
--- /dev/null
+++ b/lib/Control/Monad/Identity.hm
@@ -0,0 +1,52 @@
+module Control.Monad.Identity where
+
+import Control.Monad (class Applicative, class Monad, liftA1)
+import Data.Monoid (class Monoid, mempty)
+import Data.Traversable (class Traversable)
+import Data.Functor (class Functor, (<$>))
+import Data.Show (class Show, show)
+import Data.Foldable (class Foldable)
+import Data.Semigroup (class Semigroup, (<>))
+import Data.Ord (class Ord, compare)
+import Data.Eq (class Eq, eq)
+import Data.Function (($))
+
+data Identity x = Id x
+runIdentity :: forall a. Identity a -> a
+runIdentity (Id x) = x
+
+instance Functor Identity where
+  map f (Id x) = Id $ f x
+
+instance Applicative Identity where
+  pure = Id
+  apply (Id f) (Id x) = Id $ f x
+
+join_ :: forall a. Identity (Identity a) -> Identity a
+join_ (Id xs) = xs
+instance Monad Identity where
+  bind ma f = join_ $ f <$> ma
+
+instance Show a => Show (Identity a) where
+  show (Id x) = show x
+
+instance Eq a => Eq (Identity a) where
+  eq (Id x) (Id y) = x `eq` y
+
+instance Ord a => Ord (Identity a) where
+  compare (Id x) (Id y) = x `compare` y
+
+instance Semigroup a => Semigroup (Identity a) where
+  append x y = Id (runIdentity x <> runIdentity y)
+
+instance Monoid a => Monoid (Identity a) where
+  mempty = Id mempty
+
+instance Foldable Identity where
+  foldl f i (Id x) = f i x
+  foldr f i (Id x) = f x i
+  foldMap f (Id x) = f x
+
+instance Traversable Identity where
+  traverse f (Id x) = liftA1 Id (f x)
+  sequence (Id x)   = liftA1 Id x
diff --git a/lib/Control/Monad/RWS/RWS.hm b/lib/Control/Monad/RWS/RWS.hm
new file mode 100644
index 00000000..24dc5d91
--- /dev/null
+++ b/lib/Control/Monad/RWS/RWS.hm
@@ -0,0 +1,42 @@
+module Control.Monad.RWS.RWS where
+
+import Data.Function
+import Data.Tuple
+import Control.Monad.Identity
+import Control.Monad.Trans
+import Data.Monoid
+import Data.Functor
+import Data.Semigroup
+
+newtype RWST r w s m a = RWST (r -> s -> w -> m (a, s, w))
+unRWST :: forall r w s m a. RWST r w s m a -> r -> s -> w -> m (a, s, w)
+unRWST (RWST x) = x
+
+runRWST :: forall r w s m a. Monoid w =>
+  RWST r w s m a -> r -> s -> m (a, s, w)
+runRWST m r s = unRWST m r s mempty
+
+rwsT :: forall r w s m a. Functor m => Semigroup w =>
+  (r -> s -> m (a, s, w)) -> RWST r w s m a
+rwsT f = RWST \r s w -> (\(a, s', w') -> (a, s', w <> w')) <$> f r s
+
+evalRWST :: forall r w s f a. Functor f => Monoid w =>
+  RWST r w s f a -> r -> s -> f (a, w)
+evalRWST f r s = (\(a, _, w) -> (a, w)) <$> runRWST f r s
+
+execRWST :: forall r w s f a. Functor f => Monoid w =>
+  RWST r w s f a -> r -> s -> f (s, w)
+execRWST f r s = (\(_, s', w) -> (s', w)) <$> runRWST f r s
+
+mapRWST :: forall r w w' s m f a b. Functor f => Monoid w => Semigroup w' =>
+  (m (a, s, w) -> f (b, s, w')) -> RWST r w s m a -> RWST r w' s f b
+mapRWST f m = RWST \r s w -> (\(a, s',w') -> (a, s', w <> w')) <$> f (runRWST m r s)
+
+withRWST :: forall r r' w s m a. (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
+withRWST f m = RWST \r s -> uncurry (unRWST m) (f r s)
+
+type RWS r w s = RWST r w s Identity
+
+runRWS :: forall r w s a. Monoid w =>
+  RWS r w s a -> r -> s -> (a, s, w)
+runRWS m r s = runIdentity (runRWST m r s)
diff --git a/lib/Control/Monad/Reader.hm b/lib/Control/Monad/Reader.hm
index 55cdd30d..ed5843aa 100644
--- a/lib/Control/Monad/Reader.hm
+++ b/lib/Control/Monad/Reader.hm
@@ -1,25 +1,11 @@
-module Control.Monad.Reader where
-
-import Data.Functor (class Functor)
-import Control.Monad (class Applicative, class Monad)
-
-data Reader e a = Reader (e -> a)
-
-runReader :: forall e a. Reader e a -> e -> a
-runReader (Reader r) = r
-
-instance Functor (Reader e) where
-  map f (Reader r) = Reader (\e -> f (r e))
-
-instance Applicative (Reader e) where
-  pure a = Reader (\_ -> a)
-  apply (Reader f) (Reader r) = Reader (\e -> (f e) (r e))
-
-instance Monad (Reader e) where
-  bind (Reader r) f = Reader (\e -> runReader (f (r e)) e)
-
-ask :: forall e. Reader e e
-ask = Reader (\e -> e)
-
-local :: forall e a. (e -> a) -> Reader e a
-local f = Reader (\e -> f e)
+module Control.Monad.Reader (
+  module Control.Monad.Reader.Reader,
+  module Control.Monad.Reader.Class
+) where
+
+import Control.Monad.Reader.Reader ( ReaderT, unReaderT
+                                   , runReaderT, mapReaderT
+                                   , Reader, runReader )
+import Control.Monad.Reader.Class ( class MonadReader
+                                  , ask, local
+                                  , reader, asks )
diff --git a/lib/Control/Monad/Reader/Class.hm b/lib/Control/Monad/Reader/Class.hm
new file mode 100644
index 00000000..bb169a8a
--- /dev/null
+++ b/lib/Control/Monad/Reader/Class.hm
@@ -0,0 +1,39 @@
+module Control.Monad.Reader.Class where
+
+import Control.Monad (class Monad, bind, map, pure)
+import Control.Monad.Trans (lift)
+import Data.Function (flip, ($))
+import Control.Monad.Reader.Reader (ReaderT(..))
+import Control.Monad.State.State (StateT, mapStateT)
+import Control.Monad.Error.Either (EitherT, mapEitherT)
+import Control.Monad.Writer.Writer (WriterT(..))
+
+class Monad m => MonadReader s m | m -> s where
+  ask :: m s
+  local :: forall a. (s -> s) -> m a -> m a
+
+reader :: forall s m a. MonadReader s m =>
+  (s -> a) -> m a
+reader f = do
+  r <- ask
+  pure (f r)
+
+asks :: forall s m a. MonadReader s m =>
+  (s -> a) -> m a
+asks = flip map ask
+
+instance Monad m => MonadReader s (ReaderT s m) where
+  ask = ReaderT $ \s -> pure s
+  local f (ReaderT act) = ReaderT $ \s -> act (f s)
+
+instance MonadReader r m => MonadReader r (StateT s m) where
+  ask = lift ask
+  local f = mapStateT (local f)
+
+instance MonadReader r m => MonadReader r (EitherT e m) where
+  ask = lift ask
+  local x = mapEitherT (local x)
+
+instance MonadReader r m => MonadReader r (WriterT w m) where
+  ask = lift ask
+  local f (WriterT x) = WriterT \w -> local f (x w)
diff --git a/lib/Control/Monad/Reader/Reader.hm b/lib/Control/Monad/Reader/Reader.hm
new file mode 100644
index 00000000..648fed34
--- /dev/null
+++ b/lib/Control/Monad/Reader/Reader.hm
@@ -0,0 +1,51 @@
+module Control.Monad.Reader.Reader where
+
+import Data.Function (flip, ($))
+import Control.Monad.Identity (Identity, runIdentity)
+import Control.Monad.Trans (class MonadTrans, lift)
+import Data.Functor (class Functor, map)
+import Control.Monad (class Alternative, class Applicative, class Monad, bind, empty, pure, (<*>), (<|>), class MonadPlus, mzero, mplus)
+
+newtype ReaderT s m a = ReaderT (s -> m a)
+unReaderT :: forall s m a.
+  ReaderT s m a -> s -> m a
+unReaderT (ReaderT x) = x
+
+runReaderT :: forall s m a. s -> ReaderT s m a -> m a
+runReaderT = flip unReaderT
+
+mapReaderT :: forall s m n a b.
+  (m a -> n b) -> ReaderT s m a -> ReaderT s n b
+mapReaderT f x = ReaderT \s -> f (runReaderT s x)
+
+type Reader s a = ReaderT s Identity a
+runReader :: forall s a.
+  s -> Reader s a -> a
+runReader s act = runIdentity (runReaderT s act)
+
+instance Functor f => Functor (ReaderT s f) where
+  map f (ReaderT g) = ReaderT $ \s -> map f (g s)
+
+instance Applicative f => Applicative (ReaderT s f) where
+  pure x = ReaderT $ \s -> pure x
+  apply (ReaderT f) (ReaderT x) = ReaderT $ \s ->
+    let fs = f s
+        xs = x s
+    in fs <*> xs
+
+instance Monad m => Monad (ReaderT s m) where
+  bind (ReaderT a) f = ReaderT $ \s -> do
+    v <- a s
+    let ReaderT fv = f v
+    fv s
+
+instance MonadTrans (ReaderT s) where
+  lift x = ReaderT $ \_ -> x
+
+instance (Monad f, Alternative f) => Alternative (ReaderT s f) where
+  empty = lift empty
+  append (ReaderT f) (ReaderT g) = ReaderT $ \s -> f s <|> g s
+
+instance MonadPlus m => MonadPlus (ReaderT r m) where
+  mzero = lift mzero
+  mplus m n = ReaderT $ \r -> unReaderT m r `mplus` unReaderT n r
diff --git a/lib/Control/Monad/State.hm b/lib/Control/Monad/State.hm
index 21ef1d9e..7d27ce83 100644
--- a/lib/Control/Monad/State.hm
+++ b/lib/Control/Monad/State.hm
@@ -1,42 +1,12 @@
-module Control.Monad.State where
-
-import Data.Functor (class Functor)
-import Control.Monad (class Applicative, class Monad)
-import Data.Unit (Unit, unit)
-
-data State s a = State (s -> (a, s))
-
-runState :: forall s a. State s a -> s -> (a, s)
-runState (State f) = f
-
-evalState :: forall s a. State s a -> s -> a
-evalState (State f) s = let (a, _) = f s in a
-
-execState :: forall s a. State s a -> s -> s
-execState (State f) s = let (_, x) = f s in x
-
-instance Functor (State s) where
-  map f (State st) = State (\s -> 
-    let (a, x) = st s in (f a, x))
-
-instance Applicative (State s) where
-  pure x = State (\s -> (x, s))
-  apply (State ft) (State st) = State (\s ->
-    let (f, x) = ft s in
-    let (a, y) = st x in (f a, y))
-
-instance Monad (State s) where
-  bind (State st) f = State (\s ->
-    let (a, x) = st s in runState (f a) x)
-
-get :: forall s. State s s
-get = State (\s -> (s, s))
-
-gets :: forall s a. (s -> a) -> State s a
-gets f = State (\s -> (f s, s))
-
-put :: forall s. s -> State s ()
-put s = State (\_ -> ((), s))
-
-modify :: forall s. (s -> s) -> State s ()
-modify f = State (\s -> ((), f s))
+module Control.Monad.State (
+  module Control.Monad.State.State,
+  module Control.Monad.State.Class
+) where
+
+import Control.Monad.State.State ( StateT, unStateT
+                                 , runStateT, evalStateT, execStateT, mapStateT, withStateT
+                                 , State
+                                 , runState, evalState, execState, mapState )
+import Control.Monad.State.Class ( class MonadState
+                                 , get, put
+                                 , set, modify, gets )
diff --git a/lib/Control/Monad/State/Class.hm b/lib/Control/Monad/State/Class.hm
new file mode 100644
index 00000000..9d7957d0
--- /dev/null
+++ b/lib/Control/Monad/State/Class.hm
@@ -0,0 +1,45 @@
+module Control.Monad.State.Class where
+
+import Control.Monad (class Monad, bind, discard, pure)
+import Data.Unit (Unit, unit)
+import Control.Monad.Trans (lift)
+import Control.Monad.State.State (StateT(..))
+import Control.Monad.Error.Either (EitherT)
+import Control.Monad.Writer.Writer (WriterT)
+import Control.Monad.Reader.Reader (ReaderT)
+
+class Monad m => MonadState s m | m -> s where
+  get :: m s
+  put :: s -> m ()
+
+set :: forall s m a. Monad m => MonadState s m =>
+  (s -> (s, a)) -> m a
+set f = do s <- get
+           let (s', a) = f s
+           put s'
+           pure a
+
+modify :: forall s m. MonadState s m => (s -> s) -> m ()
+modify f = do s <- get
+              put (f s)
+
+gets :: forall s m a. MonadState s m =>
+  (s -> a) -> m a
+gets f = do s <- get
+            pure (f s)
+
+instance Monad m => MonadState s (StateT s m) where
+  get = ST (\x -> pure (x, x))
+  put x = ST (\y -> pure (x, ()))
+
+instance MonadState s m => MonadState s (EitherT e m) where
+  get = lift get
+  put x = lift (put x)
+
+instance MonadState s m => MonadState s (ReaderT r m) where
+  get = lift get
+  put x = lift (put x)
+
+instance MonadState s m => MonadState s (WriterT w m) where
+  get = lift get
+  put x = lift (put x)
diff --git a/lib/Control/Monad/State/State.hm b/lib/Control/Monad/State/State.hm
new file mode 100644
index 00000000..ad86195f
--- /dev/null
+++ b/lib/Control/Monad/State/State.hm
@@ -0,0 +1,91 @@
+module Control.Monad.State.State where
+
+import Prelude (class Applicative, class Functor, class Monad, bind, flip, fst, map, pure, snd, ($))
+import Control.Monad.Identity (Identity(..), runIdentity)
+import Control.Monad.Trans (class MonadTrans, lift)
+import Control.Monad (class Alternative, empty, (<|>), class MonadPlus, mzero, mplus)
+
+newtype StateT s m a = ST (s -> m (s, a))
+unStateT :: forall s m a.
+  StateT s m a -> s -> m (s, a)
+unStateT (ST s) = s
+
+runStateT :: forall s m a.
+  s -> StateT s m a -> m (s, a)
+runStateT = flip unStateT
+
+evalStateT :: forall s f a. Functor f =>
+  s -> StateT s f a -> f a
+evalStateT s xs = map snd (runStateT s xs)
+
+execStateT :: forall s f a. Functor f =>
+  s -> StateT s f a -> f s
+execStateT s xs = map fst (runStateT s xs)
+
+mapStateT :: forall s m n a b.
+  (m (s, a) -> n (s, b)) -> StateT s m a -> StateT s n b
+mapStateT f (ST x) = ST \s ->
+  let xs = x s
+  in f xs
+
+withStateT :: forall s m a.
+  (s -> s) -> StateT s m a -> StateT s m a
+withStateT f (ST x) = ST \s -> x (f s)
+
+type State s a = StateT s Identity a
+runState :: forall s a. s -> State s a -> (s, a)
+runState s act = runIdentity (runStateT s act)
+
+evalState :: forall s a. s -> State s a -> a
+evalState s xs = snd (runState s xs)
+
+execState :: forall s a. s -> State s a -> s
+execState s xs = fst (runState s xs)
+
+mapState :: forall s a b.
+  ((s, a) -> (s, b)) -> State s a -> State s b
+mapState f = mapStateT \(Id x) -> Id (f x)
+
+
+--| TODO: give instance to simpl.
+instance Functor f => Functor (StateT s f) where
+  map f (ST x) = ST \s ->
+    let xs = x s
+    in map (mapT_ f) xs where
+        mapT_ :: forall s_ a b.
+          (a -> b) -> (s_, a) -> (s_, b)
+        mapT_ f_ x_ = (fst x_, f_ (snd x_))
+
+--| TODO: use @ap@ to refactor @applicativeStateTsm@.
+-- ap_ :: forall m a b.
+--   Monad m => m (a -> b) -> m a -> m b
+-- ap_ f a = do
+--   f' <- f
+--   a' <- a
+--   pure (f' a')
+
+instance Monad m => Applicative (StateT s m) where
+  pure x = ST $ \s -> pure (s, x)
+  apply (ST f) (ST x) = ST $ \s -> do
+    (t, g) <- f s
+    (u, b) <- x t
+    pure (u, g b)
+
+instance Monad m => Monad (StateT s m) where
+  bind (ST a) f = ST $ \s -> do
+    (s', v) <- a s
+    let ST fv = f v
+    fv s'
+
+instance MonadTrans (StateT s) where
+  lift x = ST $ \s -> do
+    r <- x
+    pure (s, r)
+
+instance (Monad m, Alternative m) => Alternative (StateT s m) where
+  empty = lift empty
+  append (ST f) (ST g) = ST $ \s -> f s <|> g s
+
+instance MonadPlus m => MonadPlus (StateT s m) where
+  mzero = ST $ \_ -> mzero
+  mplus (ST m) (ST n) = ST $ \s -> m s `mplus` n s
diff --git a/lib/Control/Monad/Trans.hm b/lib/Control/Monad/Trans.hm
new file mode 100644
index 00000000..c5e16dbe
--- /dev/null
+++ b/lib/Control/Monad/Trans.hm
@@ -0,0 +1,6 @@
+module Control.Monad.Trans where
+
+import Control.Monad (class Monad)
+
+class MonadTrans t where
+  lift :: forall m a. Monad m => m a -> t m a
diff --git a/lib/Control/Monad/Writer.hm b/lib/Control/Monad/Writer.hm
index bab66900..bfa59d30 100644
--- a/lib/Control/Monad/Writer.hm
+++ b/lib/Control/Monad/Writer.hm
@@ -1,34 +1,13 @@
-module Control.Monad.Writer where
-
-import Data.Unit (Unit, unit)
-import Data.Semigroup ((<>))
-import Data.Monoid (class Monoid, mempty)
-import Data.Functor (class Functor)
-import Control.Monad (class Applicative, class Monad)
-
-data Writer w a = Writer (a, w)
-
-runWriter :: forall w a. Writer w a -> (a, w)
-runWriter (Writer x) = x
-
-instance Functor (Writer w) where
-  map f (Writer (a, w)) = Writer (f a, w)
-
-instance Monoid w => Applicative (Writer w) where
-  pure a = Writer (a, mempty)
-  apply (Writer (f, u)) (Writer (a, v)) =
-    Writer (f a, u <> v)
-
-instance Monoid w => Monad (Writer w) where
-  bind (Writer (a, u)) f =
-    let (Writer (b, v)) = f a in 
-    Writer (b, u <> v)
-
-tell :: forall w. w -> Writer w ()
-tell w = Writer ((), w)
-
-listen :: forall w a. Writer w a -> Writer w (a, w)
-listen (Writer (a, w)) = Writer ((a, w), w)
-
-pass :: forall w a. Writer w (a, w -> w) -> Writer w a
-pass (Writer ((a, f), w)) = Writer (a, f w)
+module Control.Monad.Writer (
+  module Control.Monad.Writer.Writer,
+  module Control.Monad.Writer.Class
+) where
+
+import Control.Monad.Writer.Writer ( WriterT, unWriterT
+                                   , writerT, runWriterT
+                                   , execWriterT, mapWriterT
+                                   , Writer, runWriter
+                                   , execWriter, mapWriter )
+import Control.Monad.Writer.Class ( class MonadWriter
+                                  , writer, listen, pass
+                                  , tell, listens, censor )
diff --git a/lib/Control/Monad/Writer/Class.hm b/lib/Control/Monad/Writer/Class.hm
new file mode 100644
index 00000000..9058a9a4
--- /dev/null
+++ b/lib/Control/Monad/Writer/Class.hm
@@ -0,0 +1,60 @@
+module Control.Monad.Writer.Class where
+
+import Data.Semigroup ((<>))
+import Control.Monad (class Monad, map, pure, bind)
+import Data.Monoid (class Monoid)
+import Data.Unit (Unit, unit)
+import Data.Functor ((<$>), mapSnd)
+import Data.Function (($), identity)
+import Control.Monad.Writer.Writer (WriterT(..), runWriterT, writerT)
+import Control.Monad.State.State (StateT(..))-- TODO.
+import Control.Monad.Trans (lift)
+import Control.Monad.Reader.Reader (ReaderT, mapReaderT)
+import Data.Either (Either(..))
+import Control.Monad.Error.Either (EitherT, mapEitherT)
+
+class (Monoid w, Monad m) => MonadWriter w m | m -> w where
+  writer :: forall a. (a, w) -> m a
+  listen :: forall a. m a -> m (a, w)
+  pass :: forall a. m (a, w -> w) -> m a
+
+tell :: forall w m. MonadWriter w m => w -> m ()
+tell w = writer ((), w)
+
+listens :: forall w m a b. MonadWriter w m =>
+  (w -> b) -> m a -> m (a, b)
+listens f x = map (mapSnd f) (listen x)
+
+censor :: forall w m a. MonadWriter w m =>
+  (w -> w) -> m a -> m a
+censor f x = pass $ map (\a -> (a, f)) x
+
+instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where
+  writer aw = writerT (pure aw)
+  listen xs = WriterT \w -> (\(a, w') -> ((a, w'), w <> w')) <$> runWriterT xs -- TODO: simpl.
+  pass xs = WriterT \w -> (\((a, f), w') -> (a, w <> f w')) <$> runWriterT xs
+
+instance MonadWriter w m => MonadWriter w (StateT s m) where
+  writer x = lift (writer x)
+  listen (ST x) = ST \s -> do
+    ((s', a), w) <- listen (x s)
+    pure (s', (a, w))
+  pass (ST x) = ST \s -> pass $ do
+    (s', (a, f)) <- x s
+    pure ((s', a), f)
+
+instance MonadWriter w m => MonadWriter w (ReaderT r m) where
+  writer xs = lift (writer xs)
+  listen xs = mapReaderT listen xs
+  pass   xs = mapReaderT pass   xs
+
+instance MonadWriter w m => MonadWriter w (EitherT e m) where
+  writer xs = lift (writer xs)
+  listen = mapEitherT \x -> do
+    (e, w) <- listen x
+    pure $ map (\a -> (a, w)) e
+  pass = mapEitherT \x -> pass $ do
+    a <- x
+    case a of
+      Right (r, f) -> pure (Right r, f)
+      Left l -> pure (Left l, identity)
diff --git a/lib/Control/Monad/Writer/Writer.hm b/lib/Control/Monad/Writer/Writer.hm
new file mode 100644
index 00000000..7cd035a6
--- /dev/null
+++ b/lib/Control/Monad/Writer/Writer.hm
@@ -0,0 +1,66 @@
+module Control.Monad.Writer.Writer where
+
+import Control.Monad.Identity (Identity(..), runIdentity)
+import Control.Monad.Trans (class MonadTrans)
+import Data.Semigroup (class Semigroup, (<>))
+import Data.Functor (class Functor, map, (<$>), mapFst, mapSnd)
+import Data.Function (($))
+import Data.Monoid (class Monoid, mempty)
+import Control.Monad (class Alternative, class Applicative, class Monad, bind, empty, pure, (<|>))
+import Data.Tuple (snd)
+
+newtype WriterT w m a = WriterT (w -> m (a, w))
+unWriterT :: forall w m a.
+  WriterT w m a -> w -> m (a, w)
+unWriterT (WriterT x) = x
+
+writerT :: forall f w a. Functor f => Semigroup w =>
+  f (a, w) -> WriterT w f a
+writerT f = WriterT $ \w -> mapSnd ((<>) w) <$> f
+
+runWriterT :: forall w m a. Monoid w => WriterT w m a -> m (a, w)
+runWriterT m = unWriterT m mempty
+
+execWriterT :: forall m w a. Functor m => Monoid w =>
+  WriterT w m a -> m w
+execWriterT xs = map snd (runWriterT xs)
+
+mapWriterT :: forall m n w w' a b. Functor n => Monoid w => Semigroup w' =>
+  (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
+mapWriterT f m = WriterT $ \w ->
+  mapSnd ((<>) w) <$> f (runWriterT m)
+
+type Writer w = WriterT w Identity
+runWriter :: forall w a. Monoid w =>
+  Writer w a -> (a, w)
+runWriter xs = runIdentity (runWriterT xs)
+
+execWriter :: forall w a. Monoid w =>
+  Writer w a -> w
+execWriter xs = runIdentity (execWriterT xs)
+
+mapWriter :: forall w w' a b. Monoid w => Semigroup w' =>
+  ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
+mapWriter f = mapWriterT \(Id p) -> Id (f p)
+
+instance Functor f => Functor (WriterT w f) where
+  map f x = WriterT (\w -> (mapFst f) <$> unWriterT x w)
+
+instance Monad m => Applicative (WriterT w m) where
+  pure x = WriterT $ \w -> pure (x, w)
+  apply (WriterT f) (WriterT x) = WriterT $ \w -> do
+    (g, t) <- f w
+    (u, b) <- x t
+    pure (g u, b)
+
+instance (Monad m, Alternative m) => Alternative (WriterT w m) where
+  empty = WriterT $ \_ -> empty
+  append (WriterT x) (WriterT y) = WriterT $ \w -> x w <|> y w
+
+instance Monad m => Monad (WriterT w m) where
+  bind ma k = WriterT $ \w -> do
+    (a, w') <- unWriterT ma w
+    unWriterT (k a) w'
+
+instance MonadTrans (WriterT w) where
+  lift m = WriterT $ \w -> map (\a -> (a, w)) m
diff --git a/lib/Data/Either.hm b/lib/Data/Either.hm
index c24ba52e..dcf05305 100644
--- a/lib/Data/Either.hm
+++ b/lib/Data/Either.hm
@@ -25,7 +25,7 @@ module Data.Either
 
 import Control.Monad (class Applicative, class Monad, pure, liftA1)
 import Data.Monoid (mempty)
-import Data.Functor (class Functor, map)
+import Data.Functor (class Functor, map, class Bifunctor)
 import Data.Foldable (class Foldable)
 import Data.Traversable (class Traversable)
 import Data.Function (error, const)
@@ -44,6 +44,10 @@ instance Functor (Either e) where
   map fn (Right x) = Right (fn x)
   map _  (Left e)  = Left e
 
+instance Bifunctor Either where
+  bimap f _ (Left  x) = Left  (f x)
+  bimap _ g (Right y) = Right (g y)
+
 instance Applicative (Either e) where
   apply (Right fn) x = map fn x
   apply (Left e)   _ = Left e
diff --git a/lib/Data/Function.hm b/lib/Data/Function.hm
index 12c678ed..31bd3d71 100644
--- a/lib/Data/Function.hm
+++ b/lib/Data/Function.hm
@@ -20,6 +20,8 @@ module Data.Function
   , pipeline, (|>)
   , identity
   , error
+  , on
+  , (<+>)
   ) where
 
 compose :: forall a b c. (b -> c) -> (a -> b) -> (a -> c)
@@ -52,3 +54,15 @@ identity :: forall a. a -> a
 identity x = x
 
 foreign import error :: forall a. String -> a
+
+dup :: forall a. a -> (a, a)
+dup x = (x, x)
+
+blackbird :: forall a b c d. (c -> d) -> (a -> b -> c) -> a -> b -> d
+blackbird = compose `compose` compose
+
+infixr 9 blackbird as .:
+
+on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
+on f g x y = g x `f` g y
+infixl 0 on as <+>
diff --git a/lib/Data/Functor.hm b/lib/Data/Functor.hm
index e6cecde2..43ed881f 100644
--- a/lib/Data/Functor.hm
+++ b/lib/Data/Functor.hm
@@ -12,7 +12,22 @@
 -- The Functor typeclass.
 --
 -----------------------------------------------------------------------------
-module Data.Functor (class Functor, map, (<$>)) where
+module Data.Functor (class Functor
+                    , map
+                    , (<$>)
+                    , class Bifunctor
+                    , mapEffL
+                    , mapEffR
+                    , ($>)
+                    , (<$)
+                    , ignore
+                    , bimap
+                    , (<<$>>)
+                    , mapFst
+                    , mapSnd) where
+
+import Data.Function (const, identity)
+import Data.Unit (Unit, unit)
 
 class Functor f where
   map :: forall a b. (a -> b) -> f a -> f b
@@ -23,3 +38,37 @@ instance Functor List where
   map = mapListImpl
 
 foreign import mapListImpl :: forall a b. (a -> b) -> List a -> List b
+
+mapEffR :: forall f a b. Functor f =>
+  f a -> b -> f b
+mapEffR fa b = map (const b) fa
+
+infixl 4 mapEffR as $>
+
+mapEffL :: forall f a b. Functor f =>
+  b -> f a -> f b
+mapEffL b = map (const b)
+
+infixl 4 mapEffL as <$
+
+ignore :: forall f a. Functor f =>
+  f a -> f ()
+ignore = map (const ())
+
+class Bifunctor f where
+  bimap :: forall a b c d.
+    (a -> b) -> (c -> d) -> f a c -> f b d
+
+infixl 4 bimap as <<$>>
+
+mapFst :: forall f a b c. Bifunctor f => (a -> b) -> f a c -> f b c
+mapFst f = bimap f identity
+
+mapSnd :: forall f a b c. Bifunctor f => (b -> c) -> f a b -> f a c
+mapSnd = bimap identity
+
+instance Bifunctor Tuple2 where
+  bimap f g (x, y) = (f x, g y)
+
+mapHom :: forall f a b. Bifunctor f => (a -> b) -> f a a -> f b b
+mapHom f = f <<$>> f