diff --git a/Clean.cabal b/Clean.cabal
--- a/Clean.cabal
+++ b/Clean.cabal
@@ -1,5 +1,5 @@
 name:                Clean
-version:             0.3
+version:             0.4
 synopsis:            A light, clean and powerful utility library
 description:         A collection of the most useful stuff I've found cleaned up
 		     and bundled in one convenient location
@@ -14,7 +14,7 @@
 
 library
   hs-source-dirs: src
-  exposed-modules:     Clean Clean.Monoid Clean.Functor Clean.Monad Clean.Arrow Clean.Applicative Clean.Foldable Clean.Traversable Clean.Lens Clean.Unit Clean.Core
+  exposed-modules:     Clean Clean.Core Clean.Functor Clean.Applicative Clean.Monad Clean.Arrow Clean.Foldable Clean.Traversable Clean.Lens
   other-modules:       Clean.Classes 
   build-depends:       base ==4.6.*, containers
   ghc-options:         -W
diff --git a/src/Clean.hs b/src/Clean.hs
--- a/src/Clean.hs
+++ b/src/Clean.hs
@@ -1,11 +1,13 @@
 module Clean(
   module Clean.Monad,
-  module Clean.Applicative,
+  module Clean.Foldable,
+  module Clean.Traversable,
+  module Clean.Arrow,
   module Clean.Core,
-  module Clean.Monoid
   ) where
 
 import Clean.Monad
-import Clean.Applicative
-import Clean.Core
-import Clean.Monoid
+import Clean.Foldable
+import Clean.Traversable
+import Clean.Arrow
+import Clean.Core hiding (flip)
diff --git a/src/Clean/Applicative.hs b/src/Clean/Applicative.hs
--- a/src/Clean/Applicative.hs
+++ b/src/Clean/Applicative.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts,FlexibleInstances #-}
 -- |A module describing applicative functors
 module Clean.Applicative(
-  module Clean.Functor,module Clean.Unit,
+  module Clean.Functor,
 
   Applicative(..),
   ZipList(..),ZipTree(..),Backwards(..),
@@ -9,10 +9,8 @@
   (*>),(<*),ap
   ) where
 
-import Clean.Monoid
 import Clean.Functor
 import Clean.Classes
-import Clean.Unit
 import Clean.Core
 import Data.Tree
 import Clean.Foldable
@@ -30,15 +28,22 @@
 instance Applicative Tree
 instance Monad Tree where
   join (Node (Node a subs) subs') = Node a (subs + map join subs')
+instance (Applicative f,Applicative g) => Applicative (Compose f g) where
+  Compose fs <*> Compose xs = Compose ((<*>)<$>fs<*>xs)
+deriving instance Unit Interleave
+instance Applicative Interleave
+instance Monad Interleave where join = fold
 
+
 {-|
 A wrapper type for lists with zipping Applicative instances, such that
 @ZipList [f1,...,fn] '<*>' ZipList [x1,...,xn] == ZipList [f1 x1,...,fn xn]@
 -}
 newtype ZipList a = ZipList { getZipList :: [a] }
-instance Nil a => Nil (ZipList a) where zero = pure zero
-instance Monoid a => Monoid (ZipList a) where
+instance Semigroup a => Semigroup (ZipList a) where
   a + b = (+)<$>a<*>b
+instance Monoid a => Monoid (ZipList a) where zero = pure zero
+
 instance Functor ZipList where
   map f (ZipList l) = ZipList (map f l)
 instance Unit ZipList where
@@ -61,14 +66,15 @@
     ZipTree (Node (f x) (getZipList ((<*>)<$>ZipList fs<*>ZipList xs)))
 deriving instance Foldable ZipTree
 
--- |A wrapper for Applicative functors with action executed in the reverse order
+-- |A wrapper for applicative functors with actions executed in the reverse order
 newtype Backwards f a = Backwards { forwards :: f a }
-deriving instance Nil (f a) => Nil (Backwards f a)
+deriving instance Semigroup (f a) => Semigroup (Backwards f a)
 deriving instance Monoid (f a) => Monoid (Backwards f a)
+deriving instance Ring (f a) => Ring (Backwards f a)
 deriving instance Unit f => Unit (Backwards f)
 deriving instance Functor f => Functor (Backwards f)
 instance Applicative f => Applicative (Backwards f) where
-  Backwards fs <*> Backwards xs = Backwards (map (flip ($)) xs <*> fs)
+  Backwards fs <*> Backwards xs = Backwards (map (&) xs <*> fs)
 
 ap = (<*>)
 a *> b = flip const<$>a<*>b
diff --git a/src/Clean/Arrow.hs b/src/Clean/Arrow.hs
--- a/src/Clean/Arrow.hs
+++ b/src/Clean/Arrow.hs
@@ -1,30 +1,61 @@
-{-# LANGUAGE DefaultSignatures #-}
-module Clean.Arrow where
+{-# LANGUAGE DefaultSignatures, TupleSections #-}
+module Clean.Arrow (
+  Arrow(..),
+  (>>>),(<<<),(>>^),(^>>),(|||),
 
-import Clean.Category
+  Apply(..),app,
+
+  Kleisli(..)
+  ) where
+
+import Clean.Core hiding (flip)
+import Clean.Classes
 import Clean.Monad
-import Clean.Core
+import Clean.Traversable
+import Clean.Lens
 
-class Split ar => Arrow ar where
-  arr :: (a -> b) -> ar a b
+(>>>) = flip (.)
+(<<<) = (.)
+(^>>) = promap
+(>>^) = (<&>)
+infixr 4 >>>,<<<,^>>,>>^
+
+class (Split k,Choice k) => Arrow k where
+  arr :: (a -> b) -> k a b
 instance Arrow (->) where arr = id
+class Arrow k => Apply k where
+  apply :: k (k a b,a) b
+instance Apply (->) where apply (f,x) = f x
+instance Arrow k => Cofunctor (Flip k a) where
+  comap f (Flip g) = Flip (arr f >>> g)
+app f = arr (f,) >>> apply
 
-class Profunctor p where
-  promap :: (a -> b) -> p b c -> p a c
-  default promap :: Arrow p => (a -> b) -> p b c -> p a c
-  promap f = (arr f >>>) 
-infixr 4 $>>
-($>>) = promap
+a ||| b = (Left<$>a) <|> (Right<$>b)
 
-a ||| b = (a >>> arr Left) <|> (b >>> arr Right)
+instance (Monad f,Contravariant f,Monad g) => Monad (Compose f g) where
+  join = map getCompose >>> getCompose >>> map collect
+         >>> join >>> map join >>> Compose
 
+kc = iso (Compose . runKleisli) (Kleisli . getCompose)
+kc' = iso (Kleisli . getCompose) (Compose . runKleisli)
 newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
+instance Unit m => Unit (Kleisli m a) where pure = Kleisli . const . pure 
+instance Functor f => Functor (Kleisli f a) where map f m = m ^. kc.lam (map f).kc'
+instance Monad m => Applicative (Kleisli m a)
+instance Monad m => Monad (Kleisli m a) where join m = m ^. kc.lam (join . map (^.kc)).kc'
+
 instance Monad m => Category (Kleisli m) where
   id = Kleisli pure
   Kleisli f . Kleisli g = Kleisli (\a -> g a >>= f)
 instance Monad m => Choice (Kleisli m) where
   Kleisli f <|> Kleisli g = Kleisli (f <|> g)
-instance (Monad m,Applicative m) => Split (Kleisli m) where
+instance Monad m => Split (Kleisli m) where
   Kleisli f <#> Kleisli g = Kleisli (\(a,c) -> (,)<$>f a<*>g c)
-instance (Monad m,Applicative m) => Arrow (Kleisli m) where
+instance Monad m => Apply (Kleisli m) where
+  apply = Kleisli (\(Kleisli f,a) -> f a)
+instance Monad m => Arrow (Kleisli m) where
   arr a = Kleisli (pure . a)
+
+
+
+
diff --git a/src/Clean/Classes.hs b/src/Clean/Classes.hs
--- a/src/Clean/Classes.hs
+++ b/src/Clean/Classes.hs
@@ -2,7 +2,6 @@
 module Clean.Classes where
 
 import Clean.Core
-import Clean.Unit
 
 class Functor f where
   map :: (a -> b) -> f a -> f b
@@ -18,5 +17,4 @@
   (>>=) :: m a -> (a -> m b) -> m b
   ma >>= k = join (map k ma)
 infixl 1 >>=
-  
-  
+
diff --git a/src/Clean/Core.hs b/src/Clean/Core.hs
--- a/src/Clean/Core.hs
+++ b/src/Clean/Core.hs
@@ -1,9 +1,28 @@
-{-# LANGUAGE NoRebindableSyntax #-}
+{-# LANGUAGE NoRebindableSyntax, MultiParamTypeClasses, FlexibleInstances, DefaultSignatures, TupleSections #-}
 module Clean.Core(
-  Category(..),Choice(..),Split(..),(:*:),(:+:),
+  -- * Basic union and product types
+  (:*:),(:+:),
 
-  first,second,left,right,ifThenElse,fail,
-  
+  -- * Basic group and ring structure
+  -- ** Classes
+  Semigroup(..),SubSemi(..),Monoid(..),Ring(..),
+  Unit(..),
+
+  -- ** Common monoids
+  Endo(..),Dual(..),OrdList(..),Interleave(..),
+
+  -- * Fundamental control operations
+  Category(..),
+  Choice(..),Split(..),
+
+  -- * Misc functions
+  const,(&),
+
+  first,second,left,right,
+
+  ifThenElse,guard,fail,
+
+  -- * The rest is imported from the Prelude
   module Prelude
   ) where
 
@@ -11,16 +30,74 @@
   Functor(..),Monad(..),
   sequence,mapM,mapM_,sequence_,(=<<),
 
-  map,(++),filter,length,sum,
-  (+),(.),id)
+  map,(++),foldl,foldr,concat,filter,length,sum,
+  (+),(*),(.),id,const)
 import qualified Prelude as P
-
-ifThenElse b th el = if b then th else el
-fail = error
+import Data.Tree
+import qualified Data.Set as S
 
 type a:*:b = (a,b)
 type a:+:b = Either a b
 
+{-|
+The class of all types that have a binary operation. Note that the operation
+isn't necesarily commutative (in the case of lists, for example)
+-} 
+class Semigroup m where
+  (+) :: m -> m -> m
+  default (+) :: Num m => m -> m -> m
+  (+) = (P.+)
+instance Semigroup () where _+_ = ()
+instance Semigroup Bool where (+) = (||)
+instance Semigroup Int
+instance Semigroup Float
+instance Semigroup Integer
+instance Ord a => Semigroup (S.Set a) where (+) = S.union
+instance Semigroup [a] where []+l = l ; (x:t)+l = x:(t+l)
+instance (Semigroup a,Semigroup b) => Semigroup (a:*:b) where (a,b)+(c,d) = (a+c,b+d)
+instance SubSemi b a => Semigroup (a:+:b) where
+  Left a+Left b = Left (a+b)
+  a+b = Right (from a+from b)
+    where from = to <|> id
+
+-- |A monoid is a semigroup with a null element such that @zero + a == a + zero == a@
+class Semigroup m => Monoid m where
+  zero :: m
+  default zero :: Num m => m
+  zero = 0
+instance Monoid () where zero = ()
+instance Monoid Int ; instance Monoid Integer ; instance Monoid Float
+instance Ord a => Monoid (S.Set a) where zero = S.empty
+instance Monoid [a] where zero = []
+instance (Monoid a,Monoid b) => Monoid (a:*:b) where zero = (zero,zero)
+instance (SubSemi b a,Monoid a) => Monoid (a:+:b) where zero = Left zero
+instance Monoid Bool where zero = False
+
+class (Semigroup a,Semigroup b) => SubSemi a b where
+  to :: b -> a
+instance Monoid a => SubSemi a () where to _ = zero
+
+class Monoid m => Ring m where
+  one :: m
+  default one :: Num m => m
+  one = 1
+  (*) :: m -> m -> m
+  default (*) :: Num m => m -> m -> m
+  (*) = (P.*)
+instance Ring Bool where one = True ; (*) = (&&)
+instance Ring Int
+instance Ring Integer
+instance Ring Float
+
+class Unit f where
+  pure :: a -> f a
+instance Unit (Either a) where pure = Right
+instance Monoid w => Unit ((,) w) where pure a = (zero,a)
+instance Unit ((->) b) where pure = P.const
+instance Unit [] where pure a = [a]
+instance Unit Tree where pure a = Node a []
+instance Unit IO where pure = P.return
+
 class Category k where
   id :: k a a
   (.) :: k b c -> k a b -> k a c
@@ -39,7 +116,45 @@
   (<#>) :: k a c -> k b d -> k (a,b) (c,d)
 instance Split (->) where f <#> g = \(a,b) -> (f a,g b)
 
+{-| A monoid on category endomorphisms under composition -}
+newtype Endo k a = Endo { runEndo :: k a a }
+instance Category k => Semigroup (Endo k a) where Endo f+Endo g = Endo (f . g)
+instance Category k => Monoid (Endo k a) where zero = Endo id
+
+{-| The dual of a monoid is the same as the original, with arguments reversed -}
+newtype Dual m = Dual { getDual :: m }
+instance Semigroup m => Semigroup (Dual m) where Dual a+Dual b = Dual (b+a)
+deriving instance Monoid m => Monoid (Dual m)
+instance Ring m => Ring (Dual m) where 
+  one = Dual one
+  Dual a * Dual b = Dual (b*a)
+
+-- |An ordered list
+newtype OrdList a = OrdList { getOrdList :: [a] }
+instance Ord a => Semigroup (OrdList a) where
+  OrdList a + OrdList b = OrdList (merge a b)
+    where merge xs@(x:xt) ys@(y:yt) | x<y = x:merge xt ys
+                                    | otherwise = y:merge xs yt
+          merge a b = a+b
+deriving instance Ord a => Monoid (OrdList a)
+deriving instance Unit OrdList
+
+newtype Interleave a = Interleave { interleave :: [a] }
+instance Semigroup (Interleave a) where
+  Interleave as + Interleave bs = Interleave (inter as bs)
+    where inter (a:as) bs = a:inter bs as
+          inter [] bs = bs
+deriving instance Monoid (Interleave a)
+
+(&) = flip ($)
+
 second a = id <#> a
 first a = a <#> id
 left a = a <|> id
 right a = id <|> a
+
+guard p = if p then pure () else zero
+
+ifThenElse b th el = if b then th else el
+fail = error
+const = pure
diff --git a/src/Clean/Foldable.hs b/src/Clean/Foldable.hs
--- a/src/Clean/Foldable.hs
+++ b/src/Clean/Foldable.hs
@@ -2,8 +2,6 @@
 module Clean.Foldable where
 
 import Clean.Core
-import Clean.Monoid
-import Clean.Unit
 import Clean.Classes
 import Clean.Functor
 import Data.Tree
@@ -16,6 +14,7 @@
 instance Foldable [] where
   fold [] = zero
   fold (x:t) = x+fold t
+deriving instance Foldable Interleave
 instance Foldable Tree where fold (Node m subs) = m + fold (map fold subs)
 
 foldMap f e = fold (map f e)
diff --git a/src/Clean/Functor.hs b/src/Clean/Functor.hs
--- a/src/Clean/Functor.hs
+++ b/src/Clean/Functor.hs
@@ -1,23 +1,37 @@
+{-# LANGUAGE FlexibleInstances #-}
 -- |A module for functors
-module Clean.Functor(Functor(..),Id(..),Const(..),(<$>),(<$),(<&>),void) where
+module Clean.Functor(
+  Functor(..),Cofunctor(..),
+  
+  Id(..),Const(..),Flip(..),Compose(..),
 
+  (<$>),(<$),(<&>),void,
+  promap
+  ) where
+
 import qualified Prelude as P
 
-import Clean.Category
 import Clean.Classes
-import Clean.Monoid
-import Clean.Unit
 import Clean.Core
 import Data.Tree
 
+class Cofunctor f where
+  comap :: (a -> b) -> f b -> f a
+instance Cofunctor (Flip (->) r) where
+  comap f (Flip g) = Flip (g . f)
+instance (Functor f,Cofunctor g) => Cofunctor (Compose f g) where
+  comap f (Compose c) = Compose (map (comap f) c)
+promap f c = unFlip (comap f (Flip c))
+
 instance Functor [] where map f = f' where f' [] = [] ; f' (x:t) = f x:f' t
 instance Functor Tree where
   map f (Node a subs) = Node (f a) (map (map f) subs)
 
 -- |The Identity Functor
 newtype Id a = Id { getId :: a }
-deriving instance Nil a => Nil (Id a)
+deriving instance Semigroup a => Semigroup (Id a)
 deriving instance Monoid w => Monoid (Id w)
+deriving instance Ring w => Ring (Id w)
 instance Unit Id where pure = Id
 instance Functor Id
 instance Applicative Id
@@ -25,16 +39,33 @@
 
 -- |The Constant Functor
 newtype Const a b = Const { getConst :: a }
-deriving instance Nil a => Nil (Const a b)
-deriving instance Monoid w => Monoid (Const w a)
+deriving instance Semigroup w => Semigroup (Const w a)
+deriving instance Monoid a => Monoid (Const a b)
 instance Unit (Const a) where pure _ = Const undefined
 instance Functor (Const a)
 instance Applicative (Const a)
 instance Monad (Const a) where Const a >>= _ = Const a
 
+-- |A motherflippin' functor
+newtype Flip f a b = Flip { unFlip :: f b a }
+
+-- |The Composition functor
+newtype Compose f g a = Compose { getCompose :: f (g a) }
+instance (Unit f,Unit g) => Unit (Compose f g) where pure = Compose . pure . pure
+instance (Functor f,Functor g) => Functor (Compose f g) where
+  map f (Compose c) = Compose (map (map f) c)
+
+newtype Product f g a = Product { getProduct :: f a:*:g a }
+instance (Functor f,Functor g) => Functor (Product f g) where
+  map f = Product . (map f <#> map f) . getProduct
+newtype Sum f g a = Sum { getSum :: f a:+:g a }
+instance (Functor f,Functor g) => Functor (Sum f g) where
+  map f = Sum . (Left<$>map f <|> Right<$>map f) . getSum
+
 instance Functor (Either b) where map f = Left <|> Right . f
 instance Functor ((,) b) where map f (b,a) = (b,f a)
 instance Functor ((->) a) where map = (.)
+deriving instance Functor Interleave
 
 instance Functor IO
 instance Applicative IO
diff --git a/src/Clean/Lens.hs b/src/Clean/Lens.hs
--- a/src/Clean/Lens.hs
+++ b/src/Clean/Lens.hs
@@ -4,6 +4,7 @@
 import Clean.Core
 import Clean.Functor
 import Clean.Applicative
+import Clean.Foldable
 
 type LensLike f s t a b = (s -> f t) -> (a -> f b)
 type LensLike' f a b = LensLike f b b a a
@@ -16,8 +17,10 @@
 iso f g = lens f (const g)
 iso' :: (a -> b) -> (b -> a) -> Lens' a b
 iso' = iso
+lam f = lens f const
 
 (^.) :: a -> Lens' a b -> b
+infixl 2 ^.
 x^.l = getConst (l Const x)
 
 type Traversal s t a b = forall f. Applicative f => LensLike f s t a b
diff --git a/src/Clean/Monad.hs b/src/Clean/Monad.hs
--- a/src/Clean/Monad.hs
+++ b/src/Clean/Monad.hs
@@ -1,21 +1,26 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TupleSections, Rank2Types #-}
 module Clean.Monad(
   module Clean.Applicative,
+
   Monad(..),MonadFix(..),MonadTrans(..),
+
   MonadState(..),
   MonadReader(..),MonadWriter(..),
+
   StateT(..),State,
-  ReaderT(..),WriterT(..),
+  ReaderT(..),Reader,WriterT(..),Writer,
+  ContT(..),Cont,
+  
   (=<<),(>>),return
   ) where
 
 import Clean.Classes
 import Clean.Applicative
-import Clean.Core
-import Clean.Monoid
+import Clean.Core hiding (flip)
+import Clean.Traversable
 
 class MonadFix m where
-  fix :: (a -> m a) -> m a
+  mfix :: (a -> m a) -> m a
 class Monad m => MonadState s m where
   get :: m s
   put :: s -> m ()
@@ -40,7 +45,12 @@
 listen_ = internal (\m -> listen m<&> \(w,(c,a)) -> (c,(w,a)))
 censor_ = internal (\m -> censor (m<&> \(c,(a,f)) -> ((c,a),f)))
 
-{- A simple State Monad  -}
+fix f = f (fix f)
+cfix f = map fix (collect f) 
+instance MonadFix Id where mfix = cfix
+instance MonadFix ((->) b) where mfix = cfix
+
+{-| A simple State Monad  -}
 newtype StateT s m a = StateT { runStateT :: s -> m (s,a) }
 type State s a = StateT s Id a
 instance Unit m => Unit (StateT s m) where pure a = StateT (\s -> pure (s,a))
@@ -59,9 +69,10 @@
   ask = ask_ ; local = local_
 instance MonadWriter w m => MonadWriter w (StateT s m) where
   tell = tell_ ; listen = listen_ ; censor = censor_
-
-{- A simple Reader monad -}
+  
+{-| A simple Reader monad -}
 newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
+type Reader r a = ReaderT r Id a
 instance MonadTrans (ReaderT r) where
   lift m = ReaderT (const m)
   internal f (ReaderT r) = ReaderT (map snd . f . map ((),) . r)
@@ -78,8 +89,9 @@
 instance MonadWriter w m => MonadWriter w (ReaderT r m) where
   tell = tell_ ; listen = listen_ ; censor = censor_
   
-{- A simple Writer monad -}
+{-| A simple Writer monad -}
 newtype WriterT w m a = WriterT { runWriterT :: m (w,a) }
+type Writer w a = WriterT w Id a
 instance Monoid w => MonadTrans (WriterT w) where
   lift m = WriterT (map (zero,) m)
   internal f (WriterT m) = WriterT (f m)
@@ -98,6 +110,18 @@
   ask = ask_ ; local = local_
 instance (Monoid w,MonadState r m) => MonadState r (WriterT w m) where
   get = get_ ; put = put_ ; modify = modify_
+
+{-| A simple continuation monad implementation  -}
+newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
+type Cont r a = ContT r Id a
+instance Unit m => Unit (ContT r m) where pure a = ContT ($a)
+instance Monad m => Functor (ContT r m)
+instance Monad m => Applicative (ContT r m)
+instance Monad m => Monad (ContT r m) where
+  ContT k >>= f = ContT (\cc -> k (\a -> runContT (f a) cc))
+instance MonadTrans (ContT r) where
+  lift m = ContT (m >>=)
+  internal _ (ContT _) = undefined
 
 (>>) = (*>)
 (=<<) = flip (>>=)
diff --git a/src/Clean/Monoid.hs b/src/Clean/Monoid.hs
deleted file mode 100644
--- a/src/Clean/Monoid.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-module Clean.Monoid where
-
-import qualified Prelude as P
-import Clean.Core
-
-class Nil z where
-  zero :: z
-instance Nil () where zero = ()
-instance Nil Int where zero = 0
-instance Nil [a] where zero = []
-instance (Nil a,Nil b) => Nil (a:*:b) where zero = (zero,zero)
-instance Nil a => Nil (a:+:b) where zero = Left zero
-
-class Nil m => Monoid m where
-  (+) :: m -> m -> m
-instance Monoid () where _+_ = ()
-instance Monoid Int where (+) = (P.+)
-instance Monoid [a] where []+l = l ; (x:t)+l = x:(t+l)
-instance (Monoid a,Monoid b) => Monoid (a:*:b) where (a,b)+(c,d) = (a+c,b+d)
-instance Submonoid b a => Monoid (a:+:b) where
-  Left a+Left b = Left (a+b)
-  a+b = Right (from a+from b)
-    where from = to <|> id
-
-class (Monoid a,Monoid b) => Submonoid a b where
-  to :: b -> a
-instance Monoid a => Submonoid a () where to _ = zero
-
-newtype Endo k a = Endo { runEndo :: k a a }
-instance Category k => Nil (Endo k a) where zero = Endo id
-instance Category k => Monoid (Endo k a) where Endo f+Endo g = Endo (f . g)
diff --git a/src/Clean/Traversable.hs b/src/Clean/Traversable.hs
--- a/src/Clean/Traversable.hs
+++ b/src/Clean/Traversable.hs
@@ -1,21 +1,21 @@
+{-# LANGUAGE FlexibleInstances #-}
 module Clean.Traversable(
-  module Clean.Foldable,module Clean.Applicative,
+  module Clean.Applicative,
 
-  Traversable(..),
+  Traversable(..),Contravariant(..),
 
-  traverse,foreach,transpose
+  traverse,foreach,transpose,flip
   ) where
 
 import Clean.Classes
-import Clean.Core
-import Clean.Foldable
+import Clean.Core hiding (flip,(&))
 import Clean.Applicative
 import Data.Tree
 
-class Foldable t => Traversable t where
+class Traversable t where
   sequence :: Applicative f => t (f a) -> f (t a)
 instance Traversable (Either a) where
-  sequence = pure . Left <|> map Right 
+  sequence = pure . Left <|> map Right
 instance Traversable [] where
   sequence (x:xs) = (:)<$>x<*>sequence xs
   sequence [] = pure []
@@ -24,8 +24,19 @@
   sequence (Node a subs) = Node<$>a<*>sequence (map sequence subs)
 deriving instance Traversable ZipTree
 
+class Contravariant t where
+  collect :: Functor f => f (t a) -> t (f a)
+instance Contravariant Id where collect f = Id (map getId f)
+instance Contravariant ((->) a) where collect f = \a -> map ($a) f
+instance (Applicative f,Contravariant f,Semigroup m) => Semigroup (f m) where
+  fa + fb = (+)<$>fa<*>fb
+instance (Applicative f,Contravariant f,Monoid m) => Monoid (f m) where
+  zero = pure zero
+instance (Applicative f,Contravariant f,Ring r) => Ring (f r) where
+  one = pure one
+  fa * fb = (*)<$>fa<*>fb
+
 traverse f t = sequence (map f t)
 foreach = flip traverse
 transpose = sequence
-
-
+flip = collect
diff --git a/src/Clean/Unit.hs b/src/Clean/Unit.hs
deleted file mode 100644
--- a/src/Clean/Unit.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Clean.Unit where
-
-import qualified Prelude as P
-import Clean.Core
-import Clean.Monoid
-import Data.Tree
-
-class Unit f where
-  pure :: a -> f a
-instance Unit (Either a) where pure = Right
-instance Monoid w => Unit ((,) w) where pure a = (zero,a)
-instance Unit ((->) b) where pure = const
-instance Unit [] where pure a = [a]
-instance Unit Tree where pure a = Node a []
-instance Unit IO where pure = P.return