diff --git a/SimpleH.cabal b/SimpleH.cabal
--- a/SimpleH.cabal
+++ b/SimpleH.cabal
@@ -1,8 +1,9 @@
 
 name:                SimpleH
-version:             0.9.1
+version:             1.0
 synopsis:            A light, clean and powerful Haskell utility library
-description: SimpleH is a Prelude complement that defines a few very useful abstractions, such as Monad transformers, Lenses, parser combinators, reactive abstractions and a few others.         
+description: SimpleH is a Prelude complement that defines a few very useful abstractions, such as Monad transformers, Lenses, parser combinators, reactive abstractions and a few others.
+  synopsis: A light, clean and powerful Haskell utility library         
 license:             BSD3
 license-file:        LICENSE
 author:              Marc Coiffier
@@ -17,7 +18,7 @@
   build-depends:       base ==4.6.*, containers ==0.5.*, clock ==0.3.*
   hs-source-dirs:      src
   extensions:  TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies
-  ghc-options:  -W
+  ghc-options:  -Wall -fno-warn-orphans
 source-repository head
   type: git
   location: git://github.com/lih/SimpleH.git
diff --git a/src/SimpleH/Applicative.hs b/src/SimpleH/Applicative.hs
--- a/src/SimpleH/Applicative.hs
+++ b/src/SimpleH/Applicative.hs
@@ -34,14 +34,14 @@
 instance Applicative []
 instance Monad [] where join = fold
 
-instance (Unit f,Unit g) => Unit (FProd f g) where pure a = FProd (pure a,pure a)
-instance (Applicative f,Applicative g) => Applicative (FProd f g) where
-  FProd ~(ff,fg) <*> FProd ~(xf,xg) = FProd (ff<*>xf,fg<*>xg)
+instance (Unit f,Unit g) => Unit (f:**:g) where pure a = pure a:**:pure a
+instance (Applicative f,Applicative g) => Applicative (f:**:g) where
+  ff:**:fg <*> xf:**:xg = (ff<*>xf) :**: (fg<*>xg)
 
 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
+instance (Applicative f,Applicative g) => Applicative (f:.:g) where
   Compose fs <*> Compose xs = Compose ((<*>)<$>fs<*>xs)
 deriving instance Unit Interleave
 instance Applicative Interleave
@@ -60,9 +60,9 @@
 instance Unit ZipList where
   pure a = ZipList (repeat a)
 instance Applicative ZipList where
-  ZipList fs <*> ZipList xs = ZipList (zip fs xs)
-    where zip (f:fs) (x:xs) = f x:zip fs xs
-          zip _ _ = []
+  ZipList zf <*> ZipList zx = ZipList (zip_ zf zx)
+    where zip_ (f:fs) (x:xs) = f x:zip_ fs xs
+          zip_ _ _ = []
 deriving instance Foldable ZipList
 
 -- |The Tree equivalent to ZipList
@@ -86,22 +86,42 @@
 instance Applicative f => Applicative (Backwards f) where
   Backwards fs <*> Backwards xs = Backwards (fs<**>xs)
 
+
+ap :: Applicative f => f (a -> b) -> f a -> f b
+
+plusA :: (Applicative f,Semigroup a) => f a -> f a -> f a
+zeroA :: (Unit f,Monoid a) => f a
+oneA :: (Unit f,Ring a) => f a
+timesA :: (Applicative f,Ring a) => f a -> f a -> f a
+
+(*>) :: Applicative f => f b -> f a -> f a
+(<*) :: Applicative f => f a -> f b -> f a
+(<**>) :: Applicative f => f (a -> b) -> f a -> f b
+
 ap = (<*>)
 infixl 2 <*,*>
 infixl 2 <**>
 (*>) = liftA2 (flip const)
 (<*) = liftA2 const
 f <**> x = liftA2 (&) x f
+
 sequence_ = foldr (*>) (pure ())
-traverse_ :: (Applicative f,Foldable t) => (a -> f b) -> t a -> f ()
+sequence_ :: (Applicative f,Foldable t) => t (f a) -> f ()
 traverse_ f = sequence_ . map f
+traverse_ :: (Applicative f,Foldable t) => (a -> f b) -> t a -> f ()
 for_ = flip traverse_
+for_ :: (Applicative f,Foldable t) => t a -> (a -> f b) -> f ()
 
+forever :: Applicative f => f a -> f b
 forever m = undefined<$sequence_ (repeat m)
 
+liftA :: Functor f => (a -> b) -> (f a -> f b)
 liftA = map
+liftA2 :: Applicative f => (a -> b -> c) -> (f a -> f b -> f c)
 liftA2 f = \a b -> f<$>a<*>b
+liftA3 :: Applicative f => (a -> b -> c -> d) -> (f a -> f b -> f c -> f d)
 liftA3 f = \a b c -> f<$>a<*>b<*>c
+liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> (f a -> f b -> f c -> f d -> f e)
 liftA4 f = \a b c d -> f<$>a<*>b<*>c<*>d
 
 plusA = liftA2 (+)
@@ -109,9 +129,10 @@
 oneA = pure one
 timesA = liftA2 (*)
 
+between :: Applicative f => f b -> f c -> f a -> f a
 between start end p = liftA3 (\_ b _ -> b) start p end
 
-instance (Applicative f,Semigroup (g a)) => Semigroup (Compose f g a) where
+instance (Applicative f,Semigroup (g a)) => Semigroup ((f:.:g) a) where
   Compose f+Compose g = Compose ((+)<$>f<*>g)
-instance (Applicative f,Monoid (g a)) => Monoid (Compose f g a) where
+instance (Applicative f,Monoid (g a)) => Monoid ((f:.:g) a) where
   zero = Compose (pure zero)
diff --git a/src/SimpleH/Arrow.hs b/src/SimpleH/Arrow.hs
--- a/src/SimpleH/Arrow.hs
+++ b/src/SimpleH/Arrow.hs
@@ -17,11 +17,13 @@
 import SimpleH.Monad
 import SimpleH.Foldable
 
-(^>>) = promap
-(>>^) = (<&>)
-infixr 4 ^>>,>>^
-dup = arr (\a -> (a,a))
+comapA :: Arrow arr => (a -> b) -> Flip arr c b -> Flip arr c a
+app :: Apply k => k a b -> k a b
 
+(^>>) :: Cofunctor (Flip f c) => (a -> b) -> f b c -> f a c
+(>>^) :: Functor f => f a -> (a -> b) -> f b
+dup :: Arrow arr => arr a (a, a)
+
 class (Split k,Choice k) => Arrow k where
   arr :: (a -> b) -> k a b
 instance Arrow (->) where arr = id
@@ -29,9 +31,6 @@
   apply :: k (k a b,a) b
 instance Apply (->) where apply (f,x) = f x
 
-comapA f (Flip g) = Flip (arr f >>> g)
-app f = arr (f,) >>> apply
-
 instance Monad m => Apply (Kleisli m) where
   apply = Kleisli (\(Kleisli f,a) -> f a)
 instance Monad m => Arrow (Kleisli m) where
@@ -48,3 +47,11 @@
                                >>> arr (\(c,d) -> (,)<$>c<*>d))
 instance Arrow k => Arrow (ListA k) where
   arr f = ListA (arr (map f))
+
+(^>>) = promap
+(>>^) = (<&>)
+infixr 4 ^>>,>>^
+dup = arr (\a -> (a,a))
+
+comapA f (Flip g) = Flip (arr f >>> g)
+app f = arr (f,) >>> apply
diff --git a/src/SimpleH/Classes.hs b/src/SimpleH/Classes.hs
--- a/src/SimpleH/Classes.hs
+++ b/src/SimpleH/Classes.hs
@@ -5,13 +5,11 @@
 
 class Functor f where
   map :: (a -> b) -> f a -> f b
-  default map :: Applicative f => (a -> b) -> f a -> f b
-  map f = (<*>) (pure f)
 class (Unit f, Functor f) => Applicative f where
   infixl 2 <*>
   (<*>) :: f (a -> b) -> f a -> f b
   default (<*>) :: Monad f => f (a -> b) -> f a -> f b
-  f <*> x = f >>= \f -> x >>= \x -> pure (f x)
+  fs <*> xs = fs >>= \f -> map f xs
 class Applicative m => Monad m where
   join :: m (m a) -> m a
   join m = m >>= id
diff --git a/src/SimpleH/Containers.hs b/src/SimpleH/Containers.hs
--- a/src/SimpleH/Containers.hs
+++ b/src/SimpleH/Containers.hs
@@ -19,13 +19,17 @@
 class DataMap m k a | m -> k a where
   lookup :: k -> m -> Maybe a
   alter :: (Maybe a -> Maybe a) -> k -> m -> m
+member :: DataMap m k Void => k -> m -> Bool
 member = map (at (from _maybe)) . lookup
-delete = alter (const Nothing) 
-minsert = alter (const (Just zero))  
+delete :: DataMap m k a => k -> m -> m
+delete = alter (const Nothing)
+minsert :: (Monoid a, DataMap m k a) => k -> m -> m
+minsert = alter (const (Just zero))
+insert :: DataMap m k a => a -> k -> m -> m
 insert = alter . const . Just
 
 instance Ord a => DataMap (S.Set a) a Void where
-  lookup = _mapping _maybe-. S.member
+  lookup = _mapping' _maybe-. S.member
   alter f a s | bef && not aft = S.delete a s
               | aft && not bef = S.insert a s
               | otherwise = s
diff --git a/src/SimpleH/Core.hs b/src/SimpleH/Core.hs
--- a/src/SimpleH/Core.hs
+++ b/src/SimpleH/Core.hs
@@ -2,18 +2,28 @@
 module SimpleH.Core(
   -- * Basic union and product types
   Void,(:*:),(:+:),vd,
-
+  
   -- * Basic group and ring structure
   -- ** Classes
-  Semigroup(..),SubSemi(..),Monoid(..),Ring(..),
+  Semigroup(..),Monoid(..),Ring(..),
+  SubSemi(..),
   Unit(..),
 
   -- ** Common monoids
-  Endo(..),Dual(..),OrdList(..),Interleave(..),Accum(..),Max(..),
-  Product(..),
+
+  -- *** Control monoids
+  Endo(..),StrictEndo(..),
+
+  -- *** Meta-monoids
+  Dual(..),Product(..),
+
+  -- *** Accumulating monoids
+  OrdList(..),Interleave(..),Accum(..),Max(..),
   
   -- * Fundamental control operations
   Category(..),(<<<),(>>>),(+++),
+
+  -- ** Splitting and Choosing
   Choice(..),Split(..),
   
   -- * Misc functions
@@ -23,10 +33,11 @@
 
   ifThenElse,bool,guard,fail,unit,when,unless,
 
-  comparing,tailSafe,headDef,
+  tailSafe,headDef,
 
+  -- ** To use with 'OrdList'
   Orderable(..),
-  insertOrd,invertOrd,
+  comparing,insertOrd,invertOrd,
   
   -- * The rest is imported from the Prelude
   module Prelude
@@ -50,7 +61,8 @@
 type a:*:b = (a,b)
 type a:+:b = Either a b
 
-vd = undefined :: Void
+vd :: Void
+vd = undefined
 
 {-|
 The class of all types that have a binary operation. Note that the operation
@@ -138,7 +150,10 @@
 instance Category (->) where
   id = P.id
   (.) = (P..)
-(<<<) = (.) ; (>>>) = flip (<<<)
+(<<<) :: Category k => k b c -> k a b -> k a c
+(<<<) = (.)
+(>>>) :: Category k => k a b -> k b c -> k a c
+(>>>) = flip (<<<)
 infixr 1 >>>,<<<
 infixr 9 .
 
@@ -166,6 +181,11 @@
 instance Category k => Semigroup (Endo k a) where Endo f+Endo g = Endo (g . f)
 instance Category k => Monoid (Endo k a) where zero = Endo id
 
+newtype StrictEndo a = StrictEndo { runStrictEndo :: a -> a }
+instance Semigroup (StrictEndo a) where
+  StrictEndo f + StrictEndo g = StrictEndo h
+    where h a = let fa = f a in fa `seq` g fa 
+
 {-| A monoid on Maybes, where the sum is the leftmost non-Nothing value. -}
 newtype Accum a = Accum { getAccum :: Maybe a }
 instance Monoid a => Semigroup (Accum a) where
@@ -197,7 +217,7 @@
 newtype OrdList a = OrdList { getOrdList :: [a] }
                   deriving (Eq,Ord,Show)
 instance Orderable a => Semigroup (OrdList a) where
-  OrdList a + OrdList b = OrdList (a ++ b)
+  OrdList oa + OrdList ob = OrdList (oa ++ ob)
     where (x:xt) ++ (y:yt) = a : c : cs
             where (a,_,z) = inOrder x y
                   ~(c:cs) = if z then xt ++ (y:yt) else (x:xt) ++ yt
@@ -212,6 +232,7 @@
     where ~(x,y) | z = (a,b)
                  | otherwise = (b,a)
           z = a<=b
+insertOrd :: Orderable t => t -> [t] -> [t]
 insertOrd e [] = [e]
 insertOrd e (x:xs) = a:y:ys
   where (a,_,z) = inOrder e x
@@ -219,33 +240,49 @@
 
 newtype Interleave a = Interleave { interleave :: [a] }
 instance Semigroup (Interleave a) where
-  Interleave as + Interleave bs = Interleave (inter as bs)
+  Interleave ia + Interleave ib = Interleave (inter ia ib)
     where inter (a:as) bs = a:inter bs as
           inter [] bs = bs
 deriving instance Monoid (Interleave a)
 
+(&) :: a -> (a -> b) -> b
 (&) = flip ($)
 infixl 0 &
 
 infixr 1 +++
+(+++) :: Split k => (a -> k c c) -> (b -> k d d) -> (a:+:b) -> k (c,d) (c,d)
 f +++ g = first.f <|> second.g
 
+second :: Split k => k a b -> k (c,a) (c,b)
 second a = id <#> a
+first :: Split k => k a b -> k (a,c) (b,c)
 first a = a <#> id
 
-guard p = if p then pure vd else zero
+guard :: (Unit m,Monoid (m ())) => Bool -> m ()
+guard p = if p then unit else zero
 
+ifThenElse :: Bool -> a -> a -> a
 ifThenElse b th el = if b then th else el
+bool :: a -> a -> Bool -> a
 bool th el b = ifThenElse b th el
+tailSafe :: [a] -> [a]
 tailSafe [] = [] ; tailSafe (_:t) = t
+headDef :: a -> [a] -> a
 headDef d [] = d ; headDef _ (x:_) = x
 
+fail :: String -> a
 fail = error
+const :: Unit m => a -> m a
 const = pure
+fix :: (a -> a) -> a
 fix f = y where y = f y
 
+unit :: Unit m => m ()
 unit = pure ()
+when :: Unit m => Bool -> m () -> m ()
 when p m = if p then m else unit
+unless :: Unit m => Bool -> m () -> m ()
 unless p m = if p then unit else m
 
+invertOrd :: Ordering -> Ordering
 invertOrd GT = LT ; invertOrd LT = GT ; invertOrd EQ = EQ
diff --git a/src/SimpleH/Foldable.hs b/src/SimpleH/Foldable.hs
--- a/src/SimpleH/Foldable.hs
+++ b/src/SimpleH/Foldable.hs
@@ -20,7 +20,7 @@
 instance Foldable Tree where fold (Node m subs) = m + fold (map fold subs)
 deriving instance Foldable Interleave
 deriving instance Foldable OrdList
-instance (Foldable f,Foldable g) => Foldable (Compose f g) where
+instance (Foldable f,Foldable g) => Foldable (f:.:g) where
   fold = getCompose >>> map fold >>> fold
 
 newtype Sized f a = Sized { getSized :: f a }
@@ -28,12 +28,23 @@
          SubSemi n (Sized f a) where
   cast = size . getSized
 
+instance (Foldable f,Foldable g) => Foldable (f:**:g) where
+  fold (f:**:g) = fold f + fold g
+instance (Foldable f,Foldable g) => Foldable (f:++:g) where
+  fold (Sum (Left f)) = fold f
+  fold (Sum (Right g)) = fold g
+
+foldMap :: (Monoid m, Foldable t) => (a -> m) -> t a -> m
 foldMap f = fold . map f
+convert :: (Unit f, Monoid (f a), Foldable t) => t a -> f a
 convert = foldMap pure
+concat :: (Monoid m, Foldable t) => t m -> m
 concat = fold
+sum :: (Monoid m, Foldable t) => t m -> m
 sum = fold
 size :: (Foldable f,Num n,Monoid n) => f a -> n
 size c = sum (1<$c)
+count :: (Num n, Monoid n, Foldable f) => f a -> n
 count = size
 length :: (Num n,Monoid n) => [a] -> n
 length = count
@@ -43,23 +54,35 @@
 partitionEithers :: (Foldable t,Unit t,Monoid (t a),Monoid (t b))
                     => t (a:+:b) -> (t a,t b)
 partitionEithers = split . map (pure|||pure)
+partition :: (Unit f, Monoid (f a), Foldable t) => (a -> Bool) -> t a -> (f a, f a)
 partition p = split . map (\a -> (if p a then Left else Right) (pure a))
+filter :: (Unit f, Monoid (f a), Foldable t) => (a -> Bool) -> t a -> f a
 filter p = fst . partition p
+select :: (Unit f, Monoid (f a), Foldable t) => (a -> Bool) -> t a -> f a
 select = filter
+refuse :: (Unit f, Monoid (f a), Foldable t) => (a -> Bool) -> t a -> f a
 refuse = filter . map not
 
+compose :: (Category k, Foldable t) => t (k a a) -> k a a
 compose = runEndo . foldMap Endo
 
 foldr :: Foldable t => (b -> a -> a) -> a -> t b -> a
 foldr f e t = (runEndo . getDual) (foldMap (\b -> Dual (Endo (f b))) t) e
+foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a
 foldl' f e t = runEndo (foldMap (\b -> Endo (\a -> a`seq`f a b)) t) e
 
+toList :: Foldable t => t a -> [a]
+toList = foldr (:) []
+
 find :: Foldable t => (a -> Bool) -> t a -> Maybe a
 find p = foldMap (filter p . Id)
 or :: Foldable t => t Bool -> Bool
 or = fold
 and :: Foldable t => t Bool -> Bool
 and = getProduct . fold . map Product
+all :: Foldable t => (a -> Bool) -> t a -> Bool
 all = map and . map
+any :: Foldable t => (a -> Bool) -> t a -> Bool
 any = map or . map
+elem :: (Eq a,Foldable t) => a -> t a -> Bool
 elem e = any (e==)
diff --git a/src/SimpleH/Functor.hs b/src/SimpleH/Functor.hs
--- a/src/SimpleH/Functor.hs
+++ b/src/SimpleH/Functor.hs
@@ -3,7 +3,7 @@
 module SimpleH.Functor(
   Functor(..),Cofunctor(..),Bifunctor(..),
   
-  Id(..),Const(..),Flip(..),Compose(..),FProd(..),Sum(..),
+  Id(..),Const(..),Flip(..),(:.:)(..),(:**:)(..),(:++:)(..),
 
   (<$>),(|||),(<$),(<&>),void,left,right,
   promap,map2,map3
@@ -17,7 +17,7 @@
 
 class Cofunctor f where
   comap :: (a -> b) -> f b -> f a
-instance (Functor f,Cofunctor g) => Cofunctor (Compose f g) where
+instance (Functor f,Cofunctor g) => Cofunctor (f:.:g) where
   comap f (Compose c) = Compose (map (comap f) c)
 instance Cofunctor (Flip (->) a) where
   comap f (Flip g) = Flip (g . f)
@@ -36,9 +36,9 @@
 newtype Id a = Id { getId :: a }
              deriving Show
 instance Unit Id where pure = Id
-instance Functor Id
+instance Functor Id where map f (Id a) = Id (f a)
 instance Applicative Id
-instance Monad Id where Id a >>= k = k a
+instance Monad Id where join (Id a) = a
 
 -- |The Constant Functor
 newtype Const a b = Const { getConst :: a }
@@ -52,16 +52,16 @@
 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
+newtype (f:.:g) a = Compose { getCompose :: f (g a) }
+instance (Unit f,Unit g) => Unit (f:.:g) where pure = Compose . pure . pure
+instance (Functor f,Functor g) => Functor (f:.:g) where
   map f (Compose c) = Compose (map (map f) c)
 
-newtype FProd f g a = FProd { getFProd :: f a:*:g a }
-instance (Functor f,Functor g) => Functor (FProd f g) where
-  map f = FProd . (map f <#> map f) . getFProd
-newtype Sum f g a = Sum { getSum :: f a:+:g a }
-instance (Functor f,Functor g) => Functor (Sum f g) where
+data (f:**:g) a = f a:**:g a
+instance (Functor f,Functor g) => Functor (f:**:g) where
+  map f (a:**:b) = map f a:**:map f b
+newtype (f:++:g) a = Sum { getSum :: f a:+:g a }
+instance (Functor f,Functor g) => Functor (f:++:g) where
   map f = Sum . (map f ||| map f) . getSum
 
 instance Functor (Either b) where map f = Left <|> Right . f
@@ -75,9 +75,11 @@
 instance Applicative IO
 instance Monad IO where (>>=) = (P.>>=)
 
+(<$>) :: Functor f => (a -> b) -> f a -> f b
 (<$>) = map
 (|||) :: (Choice k, Functor (k a), Functor (k b)) => k a c -> k b d -> k (a:+:b) (c:+:d)
 f ||| g = Left<$>f <|> Right<$>g
+(<&>) :: Functor f => f a -> (a -> b) -> f b
 x<&>f = map f x
 (<$) :: Functor f => b -> f a -> f b
 a <$ x = const a <$> x
@@ -85,7 +87,9 @@
 infixl 1 <&>
 infixr 1 |||
 
+left :: (Choice k, Functor (k a), Functor (k c)) => k a b -> k (a:+:c) (b:+:c)
 left a = a ||| id
+right :: (Choice k, Functor (k a), Functor (k c)) => k a b -> k (c:+:a) (c:+:b)
 right a = id ||| a
 
 void :: Functor f => f a -> f ()
diff --git a/src/SimpleH/Lens.hs b/src/SimpleH/Lens.hs
--- a/src/SimpleH/Lens.hs
+++ b/src/SimpleH/Lens.hs
@@ -22,7 +22,7 @@
   Traversal,Traversal',
 
   -- * Constructing lenses
-  iso,from,lens,getter,prism,
+  iso,from,lens,getter,prism,simple,
 
   -- * Extracting values
   (^.),(^..),(^?),(%~),(%-),(%%~),(%%-),at,at',warp,set,
@@ -36,7 +36,7 @@
   Isomorphic(..),
   adding,
   _Id,_OrdList,_Const,_Dual,_Endo,_Flip,_maybe,_Max,_Compose,_Backwards,
-  warp2,_mapping,_promapping,
+  warp2,_mapping,_mapping',_promapping,
   IsoFunctor(..),IsoFunctor2(..),
   _thunk
   ) where
@@ -53,7 +53,7 @@
 type Lens s t a b = forall f.Functor f => LensLike f s t a b
 type Lens' a b = Lens b b a a
 type Getter s t a b = LensLike (Const s) s t a b
-type Getter' u v a b = Getter b u a v
+type Getter' a b = Getter b b a a
 type Traversal s t a b = forall f. Applicative f => LensLike f s t a b
 type Traversal' a b = Traversal b b a a
 type Iso s t a b = forall p f. (Functor f,Bifunctor p) => p s (f t) -> p a (f b)
@@ -88,7 +88,7 @@
 lens :: (a -> s) -> (a -> t -> b) -> Lens s t a b
 lens f g = \k a -> g a <$> k (f a) 
 
-getter :: (a -> b) -> Getter' u v a b
+getter :: (a -> b) -> Getter' a b
 getter f = lens f undefined
 
 -- |Create a 'Traversal' from a maybe getter and setter function.
@@ -101,24 +101,31 @@
 
 -- |Retrieve a value from a structure using a 'Lens' (or 'Iso')
 infixl 8 ^.,^..,^?,%~,%-,%%~,%%-
+(^.) :: a -> Getter b u a v -> b
 (^.) = flip at
+(^..) :: t -> Iso s t a b -> b
 (^..) = flip at'
 -- |
+(%~) :: Traversal s t a b -> (s -> t) -> (a -> b)
 (%~) = warp
 (%%~) :: Iso s t a b -> (b -> a) -> (t -> s)
 (%%~) i = warp (from i)
+(%-) :: Traversal s t a b -> t -> (a -> b)
 (%-) = set
 (%%-) :: Iso s t a b -> a -> (t -> s)
 (%%-) i = set (from i)
 (^?) :: (Unit f,Monoid (f b)) => a -> Traversal' a b -> f b
 x^?l = getConst $ l (Const . pure) x
 
-(-.) :: Getter' u v b c -> (a -> b) -> a -> c
+simple :: Iso' a b -> Iso' a b
+simple i = i
+
+(-.) :: Getter c u b v -> (a -> b) -> a -> c
 l-.f = at l.f
 (.-) :: (b -> c) -> Iso s a t b -> a -> c
 f.-i = f.at' i
 infixr 9 -.,.-
-at :: Getter' u v a b -> a -> b
+at :: Getter b u a v -> a -> b
 at l = getConst . l Const
 at' :: Iso s t a b -> t -> b
 at' i = at (from i)
@@ -136,6 +143,7 @@
 _r :: Traversal a b (c:+:a) (c:+:b)
 _r = prism (Left ||| id) (flip (right . const))
 
+swapE :: (b:+:a) -> (a:+:b)
 swapE = Right<|>Left
 
 class Compound a b s t | s -> a, b s -> t where
@@ -156,8 +164,10 @@
 _tail :: Traversal' [a] [a]
 _tail = _list._r._2
 
-_mapping :: Functor f => Iso s t a b -> Iso (f s) (f t) (f a) (f b)
+_mapping :: (Functor f,Functor f') => Iso s t a b -> Iso (f s) (f' t) (f a) (f' b)
 _mapping (isoT -> IsoT u v) = map u `dimap` map (map v)
+_mapping' :: Functor f => Iso s t a b -> Iso (f s) (f t) (f a) (f b)
+_mapping' = _mapping
 _promapping :: Bifunctor f => Iso s t a b -> Iso (f t x) (f s y) (f b x) (f a y)
 _promapping (isoT -> IsoT u v) = dimap v id`dimap` map (dimap u id)
 -- ^_promapping :: Bifunctor f => Iso' a b -> Iso' (f a c) (f b c)
@@ -180,24 +190,35 @@
   _iso = iso Flip unFlip
 instance Isomorphic Bool Bool (Maybe Void) (Maybe Void) where
   _iso = iso (bool (Just zero) Nothing) (maybe False (const True))
-instance Isomorphic (f (g a)) (f' (g' b)) (Compose f g a) (Compose f' g' b) where
+instance Isomorphic (f (g a)) (f' (g' b)) ((f:.:g) a) ((f':.:g') b) where
   _iso = iso Compose getCompose
 instance Isomorphic a b (Void,a) (Void,b) where
   _iso = iso (vd,) snd
-_Id = _iso :: Iso' a (Id a)
-_OrdList = _iso :: Iso (OrdList a) (OrdList b) [a] [b]
-_Dual = _iso :: Iso' a (Dual a)
-_Const = _iso :: Iso' a (Const a b)
-_Max = _iso :: Iso' a (Max a)
-_Endo = _iso :: Iso' (k a a) (Endo k a)
-_maybe = _iso :: Iso' Bool (Maybe Void)
-_Flip = _iso :: Iso' (f a b) (Flip f b a)
-_Compose = _iso :: Iso (Compose f g a) (Compose f' g' b) (f (g a)) (f' (g' b))
+_Id :: Iso (Id a) (Id b) a b
+_Id = _iso
+_OrdList :: Iso (OrdList a) (OrdList b) [a] [b]
+_OrdList = _iso
+_Dual :: Iso (Dual a) (Dual b) a b
+_Dual = _iso
+_Const :: Iso (Const a c) (Const b c) a b
+_Const = _iso
+_Max :: Iso (Max a) (Max b) a b 
+_Max = _iso
+_Endo :: Iso (Endo k a) (Endo k b) (k a a) (k b b)
+_Endo = _iso 
+_maybe :: Iso' Bool (Maybe Void)
+_maybe = _iso 
+_Flip :: Iso (Flip f b a) (Flip f d c) (f a b) (f c d)
+_Flip = _iso
+_Compose :: Iso ((f:.:g) a) ((f':.:g') b) (f (g a)) (f' (g' b))
+_Compose = _iso
+_Backwards :: Iso (Backwards f a) (Backwards f b) (f a) (f b)
 _Backwards = iso Backwards forwards
+_Accum :: Iso (Accum a) (Accum b) (Maybe a) (Maybe b)
 _Accum = iso Accum getAccum
 
 warp2 :: Iso s t a b -> (s -> s -> t) -> (a -> a -> b)
-warp2 i (**) = (\b b' -> ((b^.i) ** (b'^.i))^..i)
+warp2 i f = (\b b' -> f (b^.i) (b'^.i)^..i)
 
 class IsoFunctor f where
   mapIso :: Iso s t a b -> Iso (f s) (f t) (f a) (f b)
diff --git a/src/SimpleH/Monad.hs b/src/SimpleH/Monad.hs
--- a/src/SimpleH/Monad.hs
+++ b/src/SimpleH/Monad.hs
@@ -9,6 +9,7 @@
   Kleisli(..),_Kleisli,
   (=<<),(<=<),(>=>),(>>),(<*=),return,
   foldlM,foldrM,while,until,
+  bind2,bind3,(>>>=),(>>>>=),
   
   -- * Common monads
   -- ** The RWS Monad
@@ -47,7 +48,7 @@
   -- ** The Error Monad
   MonadError(..),try,
   EitherT,
-  eitherT,runEitherT,
+  _eitherT
   ) where
 
 import SimpleH.Classes
@@ -60,7 +61,7 @@
 import Data.IORef
 import Control.Concurrent
 
-instance (Traversable g,Monad f,Monad g) => Monad (Compose f g) where
+instance (Traversable g,Monad f,Monad g) => Monad (f:.:g) where
   join = Compose .map join.join.map sequence.getCompose.map getCompose
 
 -- |The class of all monads that have a fixpoint
@@ -71,9 +72,12 @@
 instance MonadFix [] where mfix f = fix (f . head)
 instance MonadFix (Either e) where mfix f = fix (f . either undefined id)
 instance MonadFix IO where mfix = Fix.mfix
-instance (Contravariant f,Monad f,Traversable g,MonadFix g) => MonadFix (Compose f g) where
-  mfix f = Compose (map mfix (collect (getCompose . f)))
-cfix f = map fix (collect f) 
+instance (MonadFix f,Traversable g,Monad g) => MonadFix (f:.:g) where
+  mfix f = Compose $ mfix (map join . traverse (getCompose . f))
+cfix :: Contravariant c => (a -> c a) -> c a
+cfix f = map fix (collect f)
+
+mfixing :: MonadFix f => (b -> f (a, b)) -> f a
 mfixing f = fst<$>mfix (\ ~(_,b) -> f b )
 
 class MonadTrans t where
@@ -90,31 +94,52 @@
   Kleisli f <|> Kleisli g = Kleisli (f <|> g)
 instance Monad m => Split (Kleisli m) where
   Kleisli f <#> Kleisli g = Kleisli (\(a,c) -> (,)<$>f a<*>g c)
-instance Isomorphic (a -> m b) (a -> m c) (Kleisli m a b) (Kleisli m a c) where
+instance Isomorphic (a -> m b) (c -> m' d) (Kleisli m a b) (Kleisli m' c d) where
   _iso = iso Kleisli runKleisli
-_Kleisli = _iso :: Iso' (a -> m b) (Kleisli m a b)
+_Kleisli :: Iso (Kleisli m a b) (Kleisli m' c d) (a -> m b) (c -> m' d)
+_Kleisli = _iso 
 
 folding :: (Foldable t,Monoid w) => Iso' (a -> c) w -> (b -> a -> c) -> a -> t b -> c  
 folding i f e t = at (from i) (foldMap (at i . f) t) e
+foldlM :: (Foldable t,Monad m) => (b -> a -> m a) -> a -> t b -> m a
 foldlM = folding (_Kleisli._Endo._Dual)
+foldrM :: (Foldable t,Monad m) => (b -> a -> m a) -> a -> t b -> m a
 foldrM = folding (_Kleisli._Endo)
 
+while :: Monad m => m (Maybe a) -> m ()
 while e = fix (\w -> e >>= maybe unit (const w))
+until :: Monad m => m (Maybe a) -> m a
 until e = fix (\w -> e >>= maybe w return)
 
+bind2 :: Monad m => (a -> b -> m c) -> m a -> m b -> m c
+bind2 f a b = join (f<$>a<*>b)
+(>>>=) :: Monad m => (m a,m b) -> (a -> b -> m c) -> m c
+(a,b) >>>= f = bind2 f a b
+bind3 :: Monad m => (a -> b -> c -> m d) -> m a -> m b -> m c -> m d
+bind3 f a b c = join (f<$>a<*>b<*>c)
+(>>>>=) :: Monad m => (m a,m b,m c) -> (a -> b -> c -> m d) -> m d
+(a,b,c) >>>>= f = bind3 f a b c
+
 infixr 2 >>,=<<
 infixr 1 <*=
+(>>) :: Applicative f => f a -> f b -> f b
 (>>) = (*>)
+(=<<) :: Monad m => (a -> m b) -> m a -> m b
 (=<<) = flip (>>=)
+(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
 f <=< g = \a -> g a >>= f
+(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
 (>=>) = flip (<=<)
+(<*=) :: Monad m => m a -> (a -> m b) -> m a
 a <*= f = a >>= (>>)<$>f<*>return
+return :: Unit f => a -> f a
 return = pure
 
 newtype RWST r w s m a = RWST { runRWST :: (r,s) -> m (a,s,w) }
 type RWS r w s a = RWST r w s Id a
 
-_RWST :: Iso' ((r,s) -> m (a,s,w)) (RWST r w s m a)
+_RWST :: Iso (RWST r w s m a) (RWST r' w' s' m' a')
+         ((r,s) -> m (a,s,w)) ((r',s') -> m' (a',s',w'))
 _RWST = iso RWST runRWST
 
 instance (Unit f,Monoid w) => Unit (RWST r w s f) where
@@ -178,7 +203,12 @@
 _mvar :: MVar a -> IOLens a
 _mvar r = lens (const (readMVar r)) (\x a -> x >> a >>= putMVar r)
 
-get_ = lift get ; put_ = lift . put ; modify_ = lift . modify  
+get_ :: (MonadTrans t, MonadState a m) => t m a
+get_ = lift get
+put_ :: (MonadTrans t, MonadState s m) => s -> t m ()
+put_ = lift . put
+modify_ :: (MonadTrans t, MonadState s m) => (s -> s) -> t m ()
+modify_ = lift . modify  
 
 newtype StateT s m a = StateT (RWST Void Void s m a)
                      deriving (Unit,Functor,Applicative,Monad,MonadFix,
@@ -194,14 +224,16 @@
 deriving instance Monoid (m (a,s,Void)) => Monoid (StateT s m a)
 deriving instance Ring (m (a,s,Void)) => Ring (StateT s m a)
 
-_StateT :: Iso' (RWST Void Void s m a) (StateT s m a)
+_StateT :: Iso (StateT s m a) (StateT t n b) (RWST Void Void s m a) (RWST Void Void t n b)
 _StateT = iso StateT (\ ~(StateT s) -> s)
-_stateT :: Functor m => Iso' (s -> m (s,a)) (StateT s m a)
+_stateT :: (Functor m,Functor n) => Iso (StateT s m a) (StateT t n b) (s -> m (s,a)) (t -> n (t,b))
 _stateT = _mapping (_mapping $ iso (\ ~(s,a) -> (a,s,zero) ) (\(a,s,_) -> (s,a)))
           ._promapping _iso._RWST._StateT
-eval = (map . map) snd
-exec = (map . map) fst
-_state :: Iso' (s -> (s,a)) (State s a)
+eval :: (Functor f, Functor f') => f (f' (a, b)) -> f (f' b)
+eval = map2 snd
+exec :: (Functor f, Functor f') => f (f' (a, b)) -> f (f' a)
+exec = map2 fst
+_state :: Iso (State s a) (State t b) (s -> (s,a)) (t -> (t,b))
 _state = _mapping _Id._stateT
 
 (=-) :: MonadState s m => Lens' s s' -> s' -> m ()
@@ -215,23 +247,34 @@
 saving :: MonadState s m => Lens' s s' -> m a -> m a
 saving l st = gets l >>= \s -> st <* (l =- s)
 
+mapAccum :: Traversable t => (a -> s -> (s, b)) -> t a -> s -> (s, t b)
 mapAccum f t = traverse (at _state<$>f) t^.._state
+mapAccum_ :: Traversable t => (a -> s -> (s, b)) -> t a -> s -> t b
 mapAccum_ = (map.map.map) snd mapAccum
+mapAccumR :: Traversable t => (a -> s -> (s, b)) -> t a -> s -> (s, t b)
 mapAccumR f t = traverse (at (_state._Backwards)<$>f) t^.._state._Backwards
+mapAccumR_ :: Traversable t => (a -> s -> (s, b)) -> t a -> s -> t b
 mapAccumR_ = (map.map.map) snd mapAccumR
 
+push :: Traversable t => t a -> a -> t a
 push = mapAccum_ (,)
+pop :: Traversable t => t a -> a -> t a
 pop = mapAccumR_ (,)
 
-withPrev a e = (,)<$>push e a<*>e
-withNext e a = (,)<$>e<*>pop e a
+withPrev :: Traversable t => a -> t a -> t (a,a)
+withPrev = flip (mapAccum_ (\a p -> (a,(p,a))))
+withNext :: Traversable t => t a -> a -> t (a,a)
+withNext = mapAccumR_ (\a p -> (a,(p,a)))
 
 class Monad m => MonadReader r m where
   ask :: m r
   local :: (r -> r) -> m a -> m a
 instance MonadReader r ((->) r) where
   ask = id ; local = (>>>)
-ask_ = lift ask ; local_ f = internal (local f)
+ask_ :: (MonadTrans t, MonadReader a m) => t m a
+ask_ = lift ask
+local_ :: (MonadInternal t, MonadReader r m) => (r -> r) -> t m a -> t m a
+local_ f = internal (local f)
 {-| A simple Reader monad -}
 newtype ReaderT r m a = ReaderT (RWST r Void Void m a) 
                       deriving (Functor,Unit,Applicative,Monad,MonadFix,
@@ -239,10 +282,11 @@
                                 MonadReader r,MonadCont)
 type Reader r a = ReaderT r Id a
 
-_readerT :: Functor m => Iso' (r -> m a) (ReaderT r m a)
+_readerT :: (Functor m,Functor m') => Iso (ReaderT r m a) (ReaderT r' m' b) (r -> m a) (r' -> m' b)
 _readerT = iso readerT runReaderT
   where readerT f = ReaderT (RWST (\ ~(r,_) -> f r<&>(,vd,vd) ))
         runReaderT (ReaderT (RWST f)) r = f (r,vd) <&> \ ~(a,_,_) -> a
+_reader :: Iso (Reader r a) (Reader r' b) (r -> a) (r' -> b)
 _reader = _mapping _Id._readerT
 
 instance MonadState s m => MonadState s (ReaderT r m) where
@@ -257,8 +301,12 @@
   tell :: w -> m ()
   listen :: m a -> m (w,a)
   censor :: m (a,w -> w) -> m a
+
+tell_ :: (MonadWriter w m, MonadTrans t) => w -> t m ()
 tell_ = lift . tell
+listen_ :: (MonadInternal t, MonadWriter w m) => t m a -> t m (w, a)
 listen_ = internal (\m -> listen m <&> \(w,(c,a)) -> (c,(w,a)) )
+censor_ :: (MonadInternal t, MonadWriter w m) => t m (a, w -> w) -> t m a
 censor_ = internal (\m -> censor (m <&> \(c,(a,f)) -> ((c,a),f)))
 instance Monoid w => MonadWriter w ((,) w) where
   tell w = (w,())
@@ -285,10 +333,11 @@
 deriving instance Monoid (m (a,Void,w)) => Monoid (WriterT w m a)
 deriving instance Ring (m (a,Void,w)) => Ring (WriterT w m a)
 
-_writerT :: Functor m => Iso' (m (w,a)) (WriterT w m a)
+_writerT :: (Functor m,Functor m') => Iso (WriterT w m a) (WriterT w' m' b) (m (w,a)) (m' (w',b))
 _writerT = iso writerT runWriterT
-  where writerT w = WriterT (RWST (pure (w <&> \ ~(w,a) -> (a,vd,w) )))
+  where writerT mw = WriterT (RWST (pure (mw <&> \ ~(w,a) -> (a,vd,w) )))
         runWriterT (WriterT (RWST m)) = m (vd,vd) <&> \ ~(a,_,w) -> (w,a)
+_writer :: Iso (Writer w a) (Writer w' b) (w,a) (w',b)
 _writer = _Id._writerT
 
 {-| A simple continuation monad implementation  -}
@@ -310,7 +359,9 @@
 instance Monad m => MonadCont (ContT r m) where
   callCC f = ContT (\k -> runContT (f (\a -> ContT (\_ -> k a))) k)
 
+evalContT :: Unit m => ContT r m r -> m r
 evalContT c = runContT c return
+evalCont :: Cont r r -> r
 evalCont = getId . evalContT
 
 instance MonadTrans Backwards where
@@ -321,11 +372,11 @@
 class Monad m => MonadList m where
   fork :: [a] -> m a
 instance MonadList [] where fork = id
-newtype ListT m a = ListT ((m`Compose`[]) a)
+newtype ListT m a = ListT ((m:.:[]) a)
                     deriving (Semigroup,Monoid,
                               Functor,Applicative,Unit,Monad,
                               Foldable,Traversable)
-_listT :: Iso' (m [a]) (ListT m a)
+_listT :: Iso (ListT m a) (ListT m' a') (m [a]) (m' [a'])
 _listT = iso (ListT . Compose) (\(ListT (Compose m)) -> m)
 instance Monad m => MonadList (ListT m) where
   fork = at _listT . return 
@@ -341,11 +392,13 @@
   censor = _listT-.censor.map (\l -> (fst<$>l,compose (snd<$>l))).-_listT
 instance Monad m => MonadError Void (ListT m) where
   throw = const zero
-  catch f m = (m^.._listT >>= \l -> case l of [] -> f vd^.._listT; l -> pure l)^._listT
+  catch f mm = mm & _listT %%~ (\m -> m >>= \_l -> case _l of
+                                   [] -> f vd^.._listT; l -> pure l)
 
 class Monad m => MonadError e m where
-  throw :: e -> m Void
+  throw :: e -> m a
   catch :: (e -> m a) -> m a -> m a
+try :: MonadError Void m => m a -> m a -> m a
 try d = catch (\x -> const d (x::Void))
 instance MonadError e (Either e) where
   throw = Left
@@ -354,11 +407,13 @@
   throw = const zero
   catch f [] = f vd
   catch _ l = l
-newtype EitherT e m a = EitherT ((m`Compose`Either e) a)
+newtype EitherT e m a = EitherT ((m:.:Either e) a)
                       deriving (Unit,Functor,Applicative,Monad,MonadFix
                                ,Foldable,Traversable)
-eitherT = EitherT . Compose
-runEitherT (EitherT m) = getCompose m
+instance MonadTrans (EitherT e) where
+  lift m = (pure<$>m)^._eitherT
+_eitherT :: (Functor m) => Iso (EitherT e m a) (EitherT f m b) (m (e:+:a)) (m (f:+:b))                              
+_eitherT = iso (EitherT . Compose) (\(EitherT (Compose e)) -> e)
 
 instance Applicative Maybe
 instance Monad Maybe where join = fold
diff --git a/src/SimpleH/Parser.hs b/src/SimpleH/Parser.hs
--- a/src/SimpleH/Parser.hs
+++ b/src/SimpleH/Parser.hs
@@ -11,10 +11,11 @@
 type Parser w c a = ParserT w c Id a
 deriving instance (Monad m,Monoid w) => MonadError Void (ParserT w c m)
 
-_ParserT :: Iso' (StateT [c] (ListT (WriterT w m)) a) (ParserT w c m a)
+_ParserT :: Iso (ParserT w c m a) (ParserT x d n b) (StateT [c] (ListT (WriterT w m)) a) (StateT [d] (ListT (WriterT x n)) b)
 _ParserT = iso ParserT (\(ParserT p) -> p)
-_parserT :: Functor m => Iso' ([c] -> m (w,[([c],a)])) (ParserT w c m a)
+_parserT :: (Functor n,Functor m) => Iso (ParserT w c m a) (ParserT x d n b) ([c] -> m (w,[([c],a)])) ([d] -> n (x,[([d],b)]))
 _parserT = _mapping (_writerT._listT)._stateT._ParserT
+_parser :: Iso (Parser w c a) (Parser x d b) ([c] -> (w,[([c],a)])) ([d] -> (x,[([d],b)]))
 _parser = _mapping _Id._parserT
 
 remaining :: (Monad m,Monoid w) => ParserT w c m [c]
@@ -26,23 +27,34 @@
 many1 :: (Monoid w,Monad m) => ParserT w c m a -> ParserT w c m [a]
 many1 p = (:)<$>p<*>many p
 
+satisfy :: (Monoid w, Monad m) => (c -> Bool) -> ParserT w c m c
 satisfy p = token <*= (guard . p)
+single :: (Eq c, Monoid w, Monad m) => c -> ParserT w c m ()
 single c = void (satisfy (c==))
 
+several :: (Eq c, Monoid w, Monad m, Foldable t) => t c -> ParserT w c m ()
 several l = traverse_ single l
 
 option :: (Monoid w,Monad m) => a -> ParserT w c m a -> ParserT w c m a
 option a p = p+pure a
 
-eoi :: (Monad m,Monoid w) => ParserT w c m Void
+eoi :: (Monad m,Monoid w) => ParserT w c m ()
 eoi = remaining >>= guard.null
 
+sepBy1 ::(Monoid w, Monad m) => ParserT w c m a -> ParserT w c m b -> ParserT w c m [a]
 sepBy1 p sep = (:)<$>p<*>many (sep >> p)
+sepBy ::(Monoid w, Monad m) => ParserT w c m a -> ParserT w c m b -> ParserT w c m [a]
 sepBy p sep = option [] (sepBy1 p sep)
+
+(<+>) :: Semigroup m => m -> m -> m
 (<+>) = (+)
-oneOf = satisfy . elem
-noneOf = satisfy . map not . elem
 
+oneOf :: (Eq c, Monoid w, Monad m, Foldable t) => t c -> ParserT w c m c
+oneOf = satisfy . flip elem
+noneOf :: (Eq c, Monoid w, Monad m, Foldable t) => t c -> ParserT w c m c
+noneOf = satisfy . map not . flip elem
+
 infixl 1 `sepBy`,`sepBy1`,<+>
 
-chain expr op e = chain where chain = (expr<**>op<*>chain) + e
+chain :: (Semigroup (f b), Applicative f) => f a -> f (a -> b -> b) -> f b -> f b
+chain expr op e = fix $ \_chain -> ((&)<$>expr<*>op<*>_chain) + e
diff --git a/src/SimpleH/Reactive.hs b/src/SimpleH/Reactive.hs
--- a/src/SimpleH/Reactive.hs
+++ b/src/SimpleH/Reactive.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE RebindableSyntax, GeneralizedNewtypeDeriving, TupleSections, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ViewPatterns #-}
 module SimpleH.Reactive (
+  -- * Reactive Modules
   module SimpleH.Reactive.Time,
   module SimpleH.Reactive.TimeVal,
 
   -- * Reactive Events
-  Event,_event,Reactive(..),
+  Event,_event,headE,Reactive(..),
 
   -- ** Contructing events
   atTimes,mkEvent,
@@ -32,7 +33,7 @@
 import SimpleH.Reactive.Time
 
 -- |An event (a list of time-value pairs of increasing times)
-newtype Event t a = Event { getEvent :: Compose OrdList (Future t) a }
+newtype Event t a = Event { getEvent :: (OrdList:.:Future t) a }
                   deriving (Unit,Functor,Foldable,Traversable)
 data Reactive t a = Reactive a (Event t a)
 instance Ord t => Unit (Reactive t) where
@@ -41,20 +42,20 @@
   map f (Reactive a e) = Reactive (f a) (map f e)
 instance Ord t => Applicative (Reactive t) where
   Reactive f fs <*> Reactive x xs = Reactive (f x) (cons f fs<*>cons x xs)
-    where cons a = _event %%~ tail . ((minBound,a)^._future :)
+    where cons a = _event %%~ ((minBound,a)^._future :)
 
 instance (Ord t,Show t,Show a) => Show (Event t a) where show = show . at' _event
 instance Ord t => Semigroup (Event t a) where
   (+) = warp2 (from _Event) (+)
 instance Ord t => Monoid (Event t a) where zero = []^._event
 instance Ord t => Applicative (Event t) where
-  fe@(at' _event -> f:_) <*> xe@(at' _event -> x:_) =
-    (traverse (at _state) e)^.._state & \st ->
-    br ((f^._time)+(x^._time)) (snd (st (f^._value,x^._value)))
-    where e = map (\f (_,x) -> ((f,x),f x)) fe
+  fe@(at' _event -> ff:_) <*> xe@(at' _event -> fx:_) =
+    ste & traverse (at _state) & at' _state & map snd & \st ->
+    br ((ff^._time)+(fx^._time)) (st (ff^._value,fx^._value))
+    where ste = map (\f (_,x) -> ((f,x),f x)) fe
               + map (\x (f,_) -> ((f,x),f x)) xe
-          br t (at' _event -> e) = (map (_time %- t) b + a)^._event
-            where (b,a) = span (\f -> f^._time<t) (uniq e)
+          br t (at' _event -> e) = uniq (map (_time %- t) b + a)^._event
+            where (b,a) = span (\f -> f^._time<t) e
                   uniq = map last . group
   _ <*> _ = zero
 instance Ord t => Monad (Event t) where
@@ -63,15 +64,17 @@
     where merge [] = []
           merge [t] = t
           merge ([]:t) = merge t
-          merge ((x:xs):ys:t) = x:merge (sum xs ys : t)
-            where sum = warp2 _OrdList (+)
+          merge ((x:xs):ys:t) = x:merge (add xs ys : t)
+            where add = warp2 _OrdList (+)
 
 type EventRep t a = OrdList (Future t a)
 _Event :: Iso (Event t a) (Event t' b) (EventRep t a) (EventRep t' b)
 _Event = _Compose.iso Event getEvent
 _event :: Iso (Event t a) (Event t' b) [Future t a] [Future t' b]
 _event = _OrdList._Event
+atTimes :: [t] -> Event t ()
 atTimes ts = (ts <&> \t -> (pure t,())^._future)^._event
+mkEvent :: [(t,a)] -> Event t a
 mkEvent as = (as <&> at _future . (_1 %~ pure))^._event
 
 {-| The \'splice\' operator. Occurs when @a@ occurs.
@@ -79,9 +82,9 @@
 > at t: a // b = (a,before t: b)
 -}
 (//) :: Ord t => Event t a -> Event t b -> Event t (a, Event t b)
-bs // es = mapAccum_ fun (bs^.._event) (es^.._event) ^. _event
-  where fun b es = (ys,b & _value %~ (,xs^._event))
-          where (xs,ys) = span (flip ltFut b) es
+ea // eb = mapAccum_ fun (ea^.._event) (eb^.._event) ^. _event
+  where fun a bs = (ys,a & _value %~ (,xs^._event))
+          where (xs,ys) = span (flip ltFut a) bs
 infixl 1 //
 
 {-|
@@ -90,7 +93,7 @@
 > at t: a <|*> (bi,b) = a <*> (minBound,bi):b
 -}
 (<*|>) :: Ord t => Event t (a -> b) -> Reactive t a -> Event t b
-fs <*|> Reactive a as = (traverse tr (fs // as) ^.. _state <&> snd) a
+ef <*|> Reactive a ea = (traverse tr (ef // ea) ^.. _state <&> snd) a
   where tr (f,as) = traverse_ put as >> f<$>get
 infixl 2 <*|>
 (<|*>) :: Ord t => Reactive t (a -> b) -> Event t a -> Event t b
@@ -98,25 +101,44 @@
 infixr 1 <|*>
 
 -- |Group the occurences of an event by equality. Occurs when the first occurence of a group occurs. 
-groupE = _event %%~ groupE . (+repeat (Future (maxBound,undefined)))
-  where groupE fs = (f & _value %- xs):(z & _time %~ (sum (at _time<$>xs)+)):zs
+groupE :: (Eq a, Ord t) => Event t a -> Event t (Event t a)
+groupE = _event %%~ group_ . (+repeat (Future (maxBound,undefined)))
+  where group_ fs = (f & _value %- (xs^._event))
+                    : (z & _time %~ (sum_ (at _time<$>xs)+)):zs
           where (xs,ys) = span ((==f^._value) . at _value) fs ; f = head fs
-                ~(z:zs) = groupE ys
-                sum = foldl' (+) zero
+                ~(z:zs) = group_ ys
+                sum_ = foldl' (+) zero
+headE :: Event t a -> a
+headE = at _value . head . at' _event
 
+mapFutures :: (Future t a -> Future t' b) -> Event t a -> Event t' b
 mapFutures f = _event %%~ map f
+withTime :: Ord t => Event t a -> Event t (TimeVal t,a)
 withTime = mapFutures (\(Future f) -> Future (_1%~timeVal <$> listen f))
+times :: Ord t => Event t a -> Event t (TimeVal t)
 times = map2 fst withTime
 
-mask m e = (m // e) `withNext` (True,zero) >>= \((b,_),(_,e)) -> guard b >> e
+mask :: Ord t => Event t Bool -> Event t a -> Event t a
+mask m ea = (m // ea) `withNext` (True,zero) >>= \((b,_),(_,a)) -> guard b >> a
 
--- |Sinks an action event into the Real World. Each action is executed 
-sink l = for_ (withTime l) $ \(Since t,v) -> waitTill t >> v
-event m = at _event<$>event' zero
-  where event' t = unsafeInterleaveIO $ do
-          f <- futureIO (timeVal t `seq` m)
-          fs <- event' (f^._time)
-          return (f:fs)
+-- |Sinks an action event into the Real World. Actions are evaluated as
+-- closely to their time as possible
+sink :: Event Seconds (IO ()) -> IO ()
+sink l = traverse_ sink_ (withTime l)
+  where sink_ (Since t,v) = waitTill t >> v
+        sink_ (Always,v) = v
+        sink_ (Never,_) = unit
+event :: IO a -> IO (Event Seconds a)
+event m = at _event <$> do
+  c <- newChan
+  _ <- forkIO $ forever $ do
+    a <- newEmptyMVar
+    writeChan c a
+    putMVar a =<< m
+  let event' ~(a:as) = unsafeInterleaveIO $ do
+        (:)<$>futureIO (takeMVar a)<*>event' as
+  (event' =<< getChanContents c)
+    <*= forkIO . traverse_ (at' _thunk . timeVal . at _time)
 
 -- |A Future value (a value with a timestamp)
 newtype Future t a = Future (Time t,a)
@@ -133,13 +155,16 @@
 _time = from _future._1
 _value :: Lens a b (Future t a) (Future t b)
 _value = from _future._2
+
 cmpFut :: Ord t => Future t a -> Future t b -> Ordering
 cmpFut a b = compare (a^._time) (b^._time)
+ltFut :: Ord t => Future t a -> Future t b -> Bool
 ltFut a b = cmpFut a b == LT
+
 futureIO :: IO a -> IO (Future Seconds a)
 futureIO m = do
   val <- newEmptyMVar
-  forkIO $ putMVar val =<< m 
+  _ <- forkIO $ putMVar val =<< m 
   time <- timeIO (readMVar val)
   return (Future (time,readMVar val^._thunk))
 
diff --git a/src/SimpleH/Reactive/Time.hs b/src/SimpleH/Reactive/Time.hs
--- a/src/SimpleH/Reactive/Time.hs
+++ b/src/SimpleH/Reactive/Time.hs
@@ -16,121 +16,84 @@
 import Data.IORef
 import System.Clock
 
-type Bounds t = (t,t)
-type PartCmp t = t -> IO t
--- |A repeatable action that converges to a single point
-type Improve a = IO a
--- |An action that creates a new value upon each call
-type New a = IO a
 -- |A type wrappers for timestamps that can be compared unambiguously
-newtype Time t = Time (New (Improve (PartCmp (Bounds (TimeVal t)))))
-_Time = iso Time (\(Time t) -> t)
+data Time t = Time (TimeVal t -> TimeVal t) (TimeVal t -> TimeVal t)
 instance (Eq t,Show t) => Show (Time t) where show = show . timeVal
 instance Ord t => Eq (Time t) where
   a == b = compare a b == EQ
 instance Ord t => Ord (Time t) where
-  compare (Time ta) (Time tb) = at _thunk $
-    (mergeTimesBy ta tb >=> until) $ \_ a b -> do
-      let cmpV cmp a b = a (minBound,maxBound) >>= \a -> cmp a <$> b a
-      (+)<$>cmpV cmp a b<*>cmpV (flip cmp) b a 
-    where cmp (a,a') (b,b') | a'<b = Just LT | b'<a = Just GT
-                            | a==a' && b==b' = Just EQ
-                            | otherwise = Nothing
+  compare ~(Time fa fa') ~(Time fb fb') =
+    cmp fa fb' `unamb` invertOrd (cmp fb fa')
+    where cmp f f' = compare a (f'$!a)
+            where a = f maxBound
 -- |The Time semigroup where @ta + tb == max ta tb@
 instance Ord t => Semigroup (Time t) where
-  Time ta + Time tb = mergeFun (warp2 (mapIso2 _Max _Max) (+))
-                      stopMax (Time ta) (Time tb)
-    where stopMax action (a,a') (b,b') | a'<b = _ioref action =- pure tb
-                                       | a>b' = _ioref action =- pure ta
-                                       | otherwise = unit
+  ~(Time fa fa') + ~(Time fb fb') = Time (mapT max fa fb) (mapT max fa' fb')
 -- |The Time monoid where @zero == minBound@
 instance Ord t => Monoid (Time t) where
   zero = minBound
 -- |The Time ring where @(*) == min@ and @one == maxBound@
 instance Ord t => Ring (Time t) where
   one = maxBound
-  Time ta * Time tb = mergeFun (warp2 (mapIso2 _Max _Max) (*))
-                      stopMin (Time ta) (Time tb)
-    where stopMin action (a,a') (b,b') | a'<b = _ioref action =- pure ta
-                                       | a>b' = _ioref action =- pure tb
-                                       | otherwise = unit
+  ~(Time fa fa') * ~(Time fb fb') = Time (mapT min fa fb) (mapT min fa' fb')
 instance Ord t => Orderable (Time t) where
   inOrder a b = (a*b,if z then b else a,z)
     where z = a<=b
 
+mapT :: (t -> t -> a) -> (t -> t) -> (t -> t) -> t -> a
+mapT f fa fb h = f a (fb$!a) `unamb` f b (fa$!b)
+  where a = fa h ; b = fb h
+
 instance Bounded (Time t) where
-  minBound = Time (pure (pure (pure (pure (minBound,minBound)))))
-  maxBound = Time (pure (pure (pure (pure (maxBound,maxBound)))))
+  minBound = Time (pure minBound) (pure minBound)
+  maxBound = Time (pure maxBound) (pure maxBound)
 instance Unit Time where
-  pure t = Time (pure (pure (pure (pure (pure t,pure t)))))
+  pure t = Time (pure (pure t)) (pure (pure t)) 
 
+amb :: IO a -> IO a -> IO a
+ma `amb` mb = do
+  res <- newEmptyMVar
+  ta <- forkIO $ ma >>= putMVar res . Left
+  tb <- forkIO $ mb >>= putMVar res . Right
+  
+  takeMVar res >>= \c -> case c of
+    Left a -> killThread tb >> return a
+    Right a -> killThread ta >> return a
+unamb :: a -> a -> a
+unamb = warp2 (from _thunk) amb
 
 type Seconds = Double
 
-
-mergeFun f c (Time ta) (Time tb) =
-  Time $ mergeTimesBy ta tb $ \action fa fb -> return $ \h -> do
-    let cmb f c fa fb = fa h >>= \a -> fb a >>= \b -> f a b <$ c action a b
-    f<$>cmb f c fa fb<*>cmb (flip f) (map flip c) fb fa
-
-mergeTimesBy tta ttb f = join $ readIORef action
-  where action = unsafePerformIO (newIORef chan)
-        chan = newChan >>= \res -> do
-          union <- newChan
-          ta <- unsafeInterleaveIO tta ; tb <- unsafeInterleaveIO ttb
-          let consume f ta = forkIO $ tillPoint ta $ writeChan union . f
-              unknown = const (pure (minBound,maxBound))
-          consume Left ta ; consume Right tb
-          forkIO $ (\f -> f unknown unknown) $ fix $ \m a b -> do
-            r <- f action a b ; writeChan res r
-            end <- (&&)<$>isPoint a<*>isPoint b
-            if end then writeIORef action (return (pure r))
-              else (flip m b <|> m a) =<< readChan union
-            
-          return (readChan res)
-  
-isPoint f = f (minBound,maxBound) <&> uncurry (==)
-tillPoint m f = fix (\p -> m >>= \x -> f x >> isPoint x >>= flip unless p)
-timeVal (Time t) = at _thunk $ do
-  r <- newIORef undefined
-  t >>= flip tillPoint (writeIORef r <=< (&) (minBound,maxBound))
-  fst <$> readIORef r
+timeVal :: Time t -> TimeVal t
+timeVal (Time fa _) = fa maxBound
 
-timeIO io = mdo
+timeIO :: IO a -> IO (Time Seconds)
+timeIO io = do
   sem <- newEmptyMVar
-  action <- newIORef chan
-  lookup <- newIORef forkVal
-  notify <- newIORef (\c t t' -> writeVal c (pure (pure t,t')))
-
-  let chan = map readChan $ newChan <*= \ch -> do
-        forkIO $ readMVar sem >>= writeVal ch . pureFun 
-        writeChan ch $ \(_,b) -> join (
-          readIORef lookup<**>pure ch<**>currentTime<**>pure b)
-      forkVal ch t b = do 
-        forkAt b $ join (
-          readIORef notify<**>pure ch<**>currentTime<**>pure Never)
-        return (Since t,Never)
-      writeVal ch m = writeChan ch =<< (const.pure<$>m)
-      pureFun t = pure (pure t,pure t)
-            
-  forkIO $ mdo
-    io
-    _ioref action =- pure (pure t^.._Time)
-    _ioref lookup =- pure (\_ _ _ -> pure (pure t,pure t))
-    _ioref notify =- pure (const (const (const unit)))
-    t <- currentTime
+  minAction <- newIORef $ \tm -> Since<$>case tm of
+    Always -> currentTime
+    Since t -> (waitTill t >> currentTime) `amb` readMVar sem
+    Never -> readMVar sem
+  maxAction <- newIORef $ \tm -> case tm of
+    Always -> Since<$>readMVar sem
+    Since t -> (waitTill t >> pure Never) `amb` (Since<$>readMVar sem)
+    Never -> Since<$>currentTime
+    
+  let refAction ref = \t -> unsafePerformIO (join (readIORef ref<*>pure t))
+  _ <- forkIO $ do
+    t <- io >> currentTime
+    writeIORef minAction (const (pure (pure t)))
+    writeIORef maxAction (const (pure (pure t)))
     putMVar sem t
     
-  return $ Time $ join (readIORef action) 
--- print_ s a = putStrLn (s+": "+show a) >> pure a
-
+  return $ Time (refAction minAction) (refAction maxAction)
   
+waitTill :: Seconds -> IO ()
 waitTill t = do
   now <- t `seq` currentTime
   when (t>now) $ threadDelay (floor $ (t-now)*1000000)
-forkAt (Since t) io = () <$ forkIO (waitTill t >> io)
-forkAt Always io = () <$ forkIO io
-forkAt Never _ = return ()
 
+seconds :: TimeSpec -> Seconds
 seconds t = fromIntegral (sec t) + fromIntegral (nsec t)/1000000000 :: Seconds
+currentTime :: IO Seconds
 currentTime = seconds<$>getTime Realtime
diff --git a/src/SimpleH/Traversable.hs b/src/SimpleH/Traversable.hs
--- a/src/SimpleH/Traversable.hs
+++ b/src/SimpleH/Traversable.hs
@@ -28,17 +28,26 @@
 instance Traversable Tree where
   sequence (Node a subs) = Node<$>a<*>sequence (map sequence subs)
 deriving instance Traversable ZipTree
-instance (Traversable f,Traversable g) => Traversable (Compose f g) where
+instance (Traversable f,Traversable g) => Traversable (f:.:g) where
   sequence = getCompose >>> map sequence >>> sequence >>> map Compose
+instance (Traversable f,Traversable g) => Traversable (f:**:g) where
+  sequence (f:**:g) = (:**:)<$>sequence f<*>sequence g
+instance (Traversable f,Traversable g) => Traversable (f:++:g) where
+  sequence (Sum (Left f)) = Sum . Left<$>sequence f
+  sequence (Sum (Right g)) = Sum . Right<$>sequence g
 
 class Functor t => 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
 
+traverse :: (Applicative f,Traversable t) => (a -> f b) -> t a -> f (t b)
 traverse f t = sequence (map f t)
+foreach :: (Applicative f,Traversable t) => t a -> (a -> f b) -> f (t b)
 foreach = flip traverse
+transpose :: (Applicative f,Traversable t) => t (f a) -> f (t a)
 transpose = sequence
+flip :: (Contravariant c,Functor f) => f (c a) -> c (f a)
 flip = collect
 
 instance Compound a b [a] [b] where