diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,30 +1,72 @@
-Copyright (c) 2013, Marc Coiffier
+% The Greater Lunduke License
+% [Bryan Lunduke][]
+% February of 2013 (Version 1.0) 
 
-All rights reserved.
+Everyone is permitted to copy and distribute verbatim or modified
+copies of this license document, and changing it is allowed as long as
+the name of the license is changed.
 
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
+PREAMBLE
+--------
 
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
+The “Greater Lunduke License” is inspired, in part, by the wisdom of
+the Two Great Ones, Bill S. Preston, Esq. and Ted “Theodore” Logan.
+Namely that we should all “be excellent to each other”, that being
+“bogus” is “most non-triumphant” and that all dudes should “party on”.
 
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
+This license applies those concepts in such a way that it is
+applicable to all forms of content, including, but not limited to:
+software, books, music, movies and various works of art.
 
-    * Neither the name of Marc Coiffier nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
+TERMS AND CONDITIONS
+--------------------
 
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+### 1. Be Excellent To Each Other.
+
+The consumer of this work is granted the right to utilize this work in
+conjunction with any mechanism that is capable of utilizing it, in the
+form supplied by the content creator, without limitation as to
+specific hardware or software.
+
+The consumer of this work may make copies of this work (physical or
+otherwise) for backup purposes.
+
+The consumer of this work may lend this work to another individual
+provided that the following two conditions are met :
+  
+  1. the lender no longer utilizes or possesses the work
+  2. the work is not presently lent to another individual
+
+The consumer of this work may sell this work to another individual
+provided that the following two conditions are met :
+
+  1. the seller no longer utilizes or possesses the work 
+  2. once the work is sold, the seller relinquishes all rights and
+      copies of the work to the buyer.
+
+### 2. Don’t Be Bogus.
+
+The consumer of this work shall not redistribute modified, or
+unmodified, copies of this work without explicit written permission
+from the creator of this work.  The only exceptions allowed to this
+rule are the provisions outlined in section 1 of this license
+
+The consumer of this work shall not hold the creator of this work
+liable for anything the consumer does, or does not, do, or the results
+of utilizing this work.
+
+### 3. Party On, Dudes!
+
+The creator of this work provides the work in a form that contains no
+mechanism to disable the utilization of the work after a specific
+date, period of time or number of uses.
+
+If additional works, which are created and wholly owned by the work’s
+creator, are required to utilize this work, those additional works
+must also be made available to the consumer so long as the following
+conditions are met :
+  
+  1. doing so is possible
+  2. doing so does not cause harm to the creator of the work.
+
+
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,20 @@
+SimpleH : A simple Haskell for the simple programmer
+====================================================
+
+The Haskell Prelude is a very useful library that is automatically
+loaded when compiling a Haskell source file. It defines most of the
+functions that are needed to write a simple Haskell program, including
+numeric functions, list functions, I/O functions and fundamental
+control structures (Monads, Functors and the like).
+
+SimpleH isn't meant to replace the Prelude but to complement it.
+However, it redefines some standard classes in order to simplify their
+functionality so it may not interact nicely with other libraries that
+make use of the standard bindings. Still, I tried to keep the
+redefining to a minimum and to render the SimpleH experience as
+seamless as possible.
+
+_Warning:_ since I started writing SimpleH just a few weeks back,
+I haven't taken the time to properly document it yet, so you have to
+already be familiar with basic Haskell concepts in order to understand
+it. Sorry.
diff --git a/SimpleH.cabal b/SimpleH.cabal
--- a/SimpleH.cabal
+++ b/SimpleH.cabal
@@ -1,24 +1,28 @@
-
 name:                SimpleH
-version:             1.0.1
+version:             1.2
 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.
-  synopsis: A light, clean and powerful Haskell utility library         
-license:             BSD3
+description: SimpleH is a Prelude complement that defines a few very 
+  useful abstractions, such as Monad transformers, Lenses, parser 
+  combinators, reactive events and a few others.         
+license:             OtherLicense
 license-file:        LICENSE
 author:              Marc Coiffier
 maintainer:          marc.coiffier@gmail.com
 category:            Prelude
 build-type:          Simple
-cabal-version:       >=1.8
+extra-source-files:  README.md
+cabal-version:       >=1.10
 
 library
-  exposed-modules: SimpleH.Containers SimpleH.Parser SimpleH.Foldable SimpleH.Core SimpleH.Traversable SimpleH.Functor SimpleH.Reactive SimpleH.Monad SimpleH.Arrow SimpleH.Applicative SimpleH.Lens SimpleH.Reactive.TimeVal SimpleH.Reactive.Time SimpleH SimpleH.File SimpleH.Parser.CmdArgs
-  other-modules: SimpleH.Classes       
-  build-depends:       base ==4.6.*, containers ==0.5.*, bytestring ==0.10.*, directory ==1.2.*, filepath ==1.3.*, clock ==0.3.*
+  exposed-modules: Data.Containers Data.Serialize Control.Parser Control.Parser.CmdArgs Control.Parser.HTTP Control.Reactive Control.Lens Control.Reactive.Time Control.Reactive.TimeVal Algebra.Foldable Algebra.Core Algebra.Traversable Algebra.Functor Algebra.Monad Algebra.Arrow Algebra.Applicative Algebra.Monad.RWS Algebra.Monad.State Algebra.Monad.Foldable Algebra.Monad.Cont Algebra.Monad.Reader Algebra.Monad.Error Algebra.Monad.Writer System.Simple System.Simple.Network System.Simple.File SimpleH
+  other-modules: Algebra.Classes Algebra.Monad.Base       
+  other-extensions:    MultiParamTypeClasses, ScopedTypeVariables, RebindableSyntax, GeneralizedNewtypeDeriving, TupleSections, FlexibleInstances, RankNTypes, ViewPatterns, Rank2Types, FunctionalDependencies, RecursiveDo, DeriveDataTypeable, ImplicitParams, NoRebindableSyntax, DefaultSignatures, EmptyDataDecls, UndecidableInstances
+  build-depends:       base >=4.6 && <4.7, containers >=0.5 && <0.6, bytestring >=0.10 && <0.11, cpu >=0.1 && <0.2, clock >=0.3 && <0.4, network >=2.4 && <2.5, directory >=1.2 && <1.3, filepath >=1.3 && <1.4, unix >=2.6 && <2.7, time >=1.4 && <1.5
   hs-source-dirs:      src
-  extensions:  TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies
-  ghc-options:  -Wall -fno-warn-orphans
+  default-language:    Haskell2010
+  default-extensions: TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies, TupleSections, MultiParamTypeClasses, Rank2Types
+  ghc-options: -Wall -fno-warn-orphans
+
 source-repository head
   type: git
   location: git://github.com/lih/SimpleH.git
diff --git a/src/Algebra/Applicative.hs b/src/Algebra/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Applicative.hs
@@ -0,0 +1,141 @@
+-- |A module describing applicative functors
+module Algebra.Applicative(
+  module Algebra.Functor,
+
+  Applicative(..),
+  ZipList(..),ZipTree(..),Backwards(..),
+
+  (*>),(<*),(<**>),ap,sequence_,traverse_,for_,forever,
+
+  between,
+  
+  liftA,liftA2,liftA3,liftA4,
+
+  plusA,zeroA,filter
+  ) where
+
+import Algebra.Functor
+import Algebra.Classes
+import Algebra.Core
+import Data.Tree
+import Algebra.Foldable
+
+instance Applicative (Either a)
+instance Monad (Either a) where join (Right a) = a
+                                join (Left a) = Left a
+instance Applicative ((->) a)
+instance Semigroup b => Semigroup (a -> b) where (+) = plusA
+instance Monoid b => Monoid (a -> b) where zero = zeroA
+instance Ring b => Ring (a -> b) where (*) = timesA ; one = oneA
+instance Monad ((->) a) where join f x = f x x
+instance Monoid w => Applicative ((,) w)
+instance Monoid w => Monad ((,) w) where
+  join ~(w,~(w',a)) = (w+w',a)
+instance Applicative []
+instance Monad [] where join = fold
+instance Applicative Maybe
+instance Monad Maybe where join = fold
+
+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')
+deriving instance Unit Interleave
+instance Applicative Interleave
+instance Monad Interleave where join = fold
+
+instance (Applicative f,Applicative g) => Applicative (f:.:g) where
+  Compose fs <*> Compose xs = Compose ((<*>)<$>fs<*>xs)
+
+{-|
+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 Semigroup a => Semigroup (ZipList a) where (+) = plusA
+instance Monoid a => Monoid (ZipList a) where zero = zeroA
+
+instance Functor ZipList where
+  map f (ZipList l) = ZipList (map f l)
+instance Unit ZipList where
+  pure a = ZipList (repeat a)
+instance Applicative ZipList where
+  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
+newtype ZipTree a = ZipTree (Tree a)
+instance Functor ZipTree where
+  map f (ZipTree t) = ZipTree (map f t)
+instance Unit ZipTree where
+  pure a = ZipTree (Node a (getZipList (pure (pure a))))
+instance Applicative ZipTree where
+  ZipTree (Node f fs) <*> ZipTree (Node x xs) =
+    ZipTree (Node (f x) (getZipList ((<*>)<$>ZipList fs<*>ZipList xs)))
+deriving instance Foldable ZipTree
+
+-- |A wrapper for applicative functors with actions executed in the reverse order
+newtype Backwards f a = Backwards { forwards :: 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 (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 1 <*
+infixl 2 <**>,*>
+(*>) = liftA2 (flip const)
+(<*) = liftA2 const
+f <**> x = liftA2 (&) x f
+
+sequence_ = foldr (*>) (pure ())
+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 = fix (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 (+)
+zeroA = pure zero
+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 ((f:.:g) a) where
+  Compose f+Compose g = Compose ((+)<$>f<*>g)
+instance (Applicative f,Monoid (g a)) => Monoid ((f:.:g) a) where
+  zero = Compose (pure zero)
diff --git a/src/Algebra/Arrow.hs b/src/Algebra/Arrow.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Arrow.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE DefaultSignatures, TupleSections #-}
+module Algebra.Arrow (
+  module Algebra.Monad,
+  
+  Arrow(..),
+  (>>^),(^>>),
+
+  Apply(..),comapA,app,dup,
+
+  Kleisli(..),
+
+  ListA(..)
+  ) where
+
+import Algebra.Core hiding (flip)
+import Algebra.Classes
+import Algebra.Monad
+
+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
+instance Monad m => Arrow (StateA m) where
+  arr f = StateA (f<$>get)
+
+class Arrow k => Apply k where
+  apply :: k (k a b,a) b
+instance Apply (->) where apply (f,x) = f x
+
+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)
+
+newtype ListA k a b = ListA { runListA :: k [a] [b] }
+instance Category k => Category (ListA k) where
+  id = ListA id
+  ListA a . ListA b = ListA (a . b)
+instance Arrow k => Choice (ListA k) where
+  ListA f <|> ListA g = ListA (arr partitionEithers >>> (f<#>g) >>> arr (uncurry (+)))
+instance Arrow k => Split (ListA k) where
+  ListA f <#> ListA g = ListA (arr (\l -> (fst<$>l,snd<$>l)) >>> (f<#>g)
+                               >>> 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/Algebra/Classes.hs b/src/Algebra/Classes.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Classes.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DefaultSignatures #-}
+module Algebra.Classes where
+
+import Algebra.Core
+
+class Functor f where
+  map :: (a -> b) -> f a -> f b
+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
+  fs <*> xs = fs >>= \f -> map f xs
+class Applicative m => Monad m where
+  join :: m (m a) -> m a
+  join m = m >>= id
+  infixl 1 >>=
+  (>>=) :: m a -> (a -> m b) -> m b
+  ma >>= k = join (map k ma)
+
+-- |The class of all monads that have a fixpoint
+class Monad m => MonadFix m where
+  mfix :: (a -> m a) -> m a
+class MonadTrans t where
+  lift :: Monad m => m a -> t m a
+  generalize :: Monad m => t Id a -> t m a
+
+class Monad m => MonadState s m | m -> s where
+  get :: m s
+  put :: s -> m ()
+  put = modify . const
+  modify :: (s -> s) -> m ()
+  modify f = get >>= put . f
+class Monad m => MonadReader r m | m -> r where
+  ask :: m r
+  local :: (r -> r) -> m a -> m a
+class (Monad m,Monoid w) => MonadWriter w m | m -> w where
+  tell :: w -> m ()
+  listen :: m a -> m (w,a)
+  censor :: m (a,w -> w) -> m a
+
+class Monad m => MonadList m where
+  fork :: [a] -> m a
+class Monad m => MonadCont m where
+  callCC :: ((a -> m b) -> m a) -> m a
+class Monad m => MonadError e m | m -> e where
+  throw :: e -> m a
+  catch :: (e -> m a) -> m a -> m a
+
diff --git a/src/Algebra/Core.hs b/src/Algebra/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Core.hs
@@ -0,0 +1,317 @@
+{-# LANGUAGE NoRebindableSyntax, MultiParamTypeClasses, DefaultSignatures, TupleSections, EmptyDataDecls #-}
+module Algebra.Core(
+  -- * Raw data
+  BS.ByteString,BS.readFile,BS.writeFile,BS.hGetContents,
+
+  -- * Basic union and product types
+  Void,(:*:),(:+:),
+  
+  -- * Basic group and ring structure
+  -- ** Classes
+  Semigroup(..),Monoid(..),Ring(..),
+  SubSemi(..),
+  Unit(..),
+
+  -- ** Common monoids
+
+  -- *** Control monoids
+  Endo(..),StrictEndo(..),
+
+  -- *** Meta-monoids
+  Dual(..),Product(..),
+
+  -- *** Accumulating monoids
+  OrdList(..),Interleave(..),Accum(..),Max(..),Id(..),
+  
+  -- * Fundamental control operations
+  Category(..),(<<<),(>>>),(+++),
+
+  -- ** Splitting and Choosing
+  Choice(..),Split(..),
+  
+  -- * Misc functions
+  const,(&),is,fix,
+
+  first,second,
+
+  ifThenElse,bool,guard,fail,unit,when,unless,
+
+  tailSafe,headDef,
+
+  rmod,inside,swap,
+
+  -- ** Lazily ordering values
+  Orderable(..),
+  comparing,insertOrd,invertOrd,
+  
+  -- * The rest is imported from the Prelude
+  module Prelude
+  ) where
+
+import Prelude hiding (
+  readFile,writeFile,
+
+  Functor(..),Monad(..),
+
+  sequence,mapM,mapM_,sequence_,(=<<),
+
+  map,(++),foldl,foldr,foldr1,concat,filter,length,sum,lookup,
+  (+),(*),(.),id,const,
+
+  or,any,and,all,elem,
+
+  until)
+import qualified Prelude as P
+import Data.Tree
+import qualified Data.ByteString as BS
+import Data.Ord (comparing)
+
+data Void
+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.+)
+infixl 6 +
+instance Semigroup Void where _+_ = undefined
+instance Semigroup () where _+_ = ()
+instance Semigroup Bool where (+) = (||)
+instance Semigroup Int
+instance Semigroup Float
+instance Semigroup Double
+instance Semigroup Integer
+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 (Semigroup a,Semigroup b,Semigroup c) => Semigroup (a,b,c) where
+  ~(a,b,c) + ~(a',b',c') = (a+a',b+b',c+c')
+instance SubSemi b a => Semigroup (a:+:b) where
+  Left a+Left b = Left (a+b)
+  a+b = Right (from a+from b)
+    where from = cast <|> id
+instance Semigroup (Maybe a) where
+  Nothing + b = b ; a + _ = a
+
+-- |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 Void where zero = undefined
+instance Monoid () where zero = ()
+instance Monoid Int ; instance Monoid Integer
+instance Monoid Float ; instance Monoid Double
+instance Monoid [a] where zero = []
+instance (Monoid a,Monoid b) => Monoid (a:*:b) where zero = (zero,zero)
+instance (Monoid a,Monoid b,Monoid c) => Monoid (a,b,c) where
+  zero = (zero,zero,zero)
+instance (SubSemi b a,Monoid a) => Monoid (a:+:b) where zero = Left zero
+instance Monoid Bool where zero = False
+instance Monoid (Maybe a) where zero = Nothing
+
+class (Semigroup a,Semigroup b) => SubSemi a b where
+  cast :: b -> a
+instance Monoid a => SubSemi a () where cast _ = zero
+instance Monoid a => SubSemi a Void where cast _ = 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.*)
+
+infixl 7 *
+instance Ring Bool where one = True ; (*) = (&&)
+instance Ring Int
+instance Ring Integer
+instance Ring Float
+instance Ring Double
+instance Monoid a => Ring [a] where
+  one = zero:one
+  (a:as) * (b:bs) = a+b:as*bs
+  _ * _ = zero
+instance (Ring a,Ring b) => Ring (a:*:b) where
+  one = (one,one) ; ~(a,b) * ~(c,d) = (a*c,b*d)
+
+-- class Ring n => Integral n where
+--   fromInteger :: Integer -> n
+--   toInteger :: n -> Integer
+  
+class Unit f where
+  pure :: a -> f a
+instance Unit (Either a) where pure = Right
+instance Unit Maybe where pure = Just
+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
+instance Category (->) where
+  id = P.id
+  (.) = (P..)
+(<<<) :: 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 .
+
+class Category k => Choice k where
+  (<|>) :: k a c -> k b c -> k (a:+:b) c
+infixr 1 <|>
+instance Choice (->) where
+  (f <|> _) (Left a) = f a
+  (_ <|> g) (Right b) = g b
+
+class Category k => Split k where
+  (<#>) :: k a c -> k b d -> k (a,b) (c,d)
+infixr 2 <#>
+instance Split (->) where f <#> g = \ ~(a,b) -> (f a,g b)
+
+{-| The Product monoid -}
+newtype Product a = Product { getProduct :: a }
+instance Ring a => Semigroup (Product a) where
+  Product a+Product b = Product (a*b) 
+instance Ring a => Monoid (Product a) where
+  zero = Product one
+
+{-| 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 (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
+  Accum Nothing + Accum Nothing = Accum Nothing
+  Accum a + Accum b = Accum (Just (from a+from b))
+    where from = maybe zero id
+instance Monoid a => Monoid (Accum a) where zero = Accum Nothing
+instance Unit Accum where pure = Accum . pure
+
+-- |The Identity Functor
+newtype Id a = Id { getId :: a }
+             deriving Show
+instance Unit Id where pure = Id
+
+{-| The Max monoid, where @(+) =~ max@ -}
+newtype Max a = Max { getMax :: a }
+              deriving (Eq,Ord,Bounded,Show)
+instance Ord a => Semigroup (Max a) where Max a+Max b = Max (max a b)
+instance (Ord a,Bounded a) => Monoid (Max a) where zero = Max minBound
+instance (Ord a,Bounded a) => Ring (Max a) where
+  one = Max maxBound
+  Max a * Max b = Max (min a b)
+
+{-| 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. The semigroup instance merges two lists so that
+-- the result remains in ascending order.
+newtype OrdList a = OrdList { getOrdList :: [a] }
+                  deriving (Eq,Ord,Show)
+instance Orderable a => Semigroup (OrdList a) where
+  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
+          a ++ b = a + b
+deriving instance Orderable a => Monoid (OrdList a)
+deriving instance Unit OrdList
+
+class Ord t => Orderable t where
+  inOrder :: t -> t -> (t,t,Bool)
+instance Ord t => Orderable (Max t) where
+  inOrder (Max a) (Max b) = (Max x,Max y,z)
+    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
+        ~(y:ys) = if z then x:xs else insertOrd e xs
+
+newtype Interleave a = Interleave { interleave :: [a] }
+instance Semigroup (Interleave a) where
+  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 &
+is :: a -> (a -> Bool) -> Bool
+is = (&)
+
+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 :: (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
+
+inside :: Ord t => t -> t -> (t -> Bool)
+inside x y = \z -> x<z && z<y
+
+rmod :: (RealFrac m,Ring m) => m -> m -> m
+a`rmod`b = b * r 
+  where _n :: Int
+        (_n,r) = properFraction (a/b)
+infixl 7 `rmod`
+
+swap :: (a,b) -> (b,a)
+swap (a,b) = (b,a)
diff --git a/src/Algebra/Foldable.hs b/src/Algebra/Foldable.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Foldable.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE TupleSections, MultiParamTypeClasses #-}
+module Algebra.Foldable where
+
+import Algebra.Core
+import Algebra.Classes
+import Algebra.Functor
+import Data.Tree
+
+class Functor t => Foldable t where
+  fold :: Monoid m => t m -> m
+instance Foldable Id where fold = getId
+instance Foldable (Either a) where
+  fold = pure zero <|> id
+instance Foldable Maybe where
+  fold (Just w) = w ; fold Nothing = zero
+instance Foldable ((,) a) where fold = snd
+instance Foldable [] where
+  fold [] = zero
+  fold (x:t) = x+fold t
+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 (f:.:g) where
+  fold = getCompose >>> map fold >>> fold
+
+newtype Sized f a = Sized { getSized :: f a }
+instance (Foldable f,Semigroup (Sized f a),Monoid n,Num n) =>
+         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
+
+split :: (Foldable t,Monoid b,Monoid c) => t (b:+:c) -> (b,c)
+split = foldMap ((,zero)<|>(zero,))
+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
+foldr1 :: (a -> a -> a) -> [a] -> a
+foldr1 f ~(e:t) = foldr f e t
+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
+foldl1' :: (a -> a -> a) -> [a] -> a
+foldl1' f ~(e:t) = foldl' f e t
+
+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==)
+
+empty :: Foldable f => f a -> Bool
+empty = foldr (const (const False)) True
diff --git a/src/Algebra/Functor.hs b/src/Algebra/Functor.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Functor.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE MultiParamTypeClasses, RankNTypes, DefaultSignatures #-}
+-- |A module for functors
+module Algebra.Functor(
+  Functor(..),Cofunctor(..),Bifunctor(..),
+  
+  Id(..),Const(..),Flip(..),(:.:)(..),(:**:)(..),(:++:)(..),
+
+  (<$>),(|||),(<$),(<&>),void,left,right,
+  promap,map2,map3
+  ) where
+
+import qualified Prelude as P
+
+import Algebra.Classes
+import Algebra.Core
+import Data.Tree
+
+class Cofunctor f where
+  comap :: (a -> b) -> f b -> f a
+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)
+instance Bifunctor (->)
+
+class Bifunctor p where
+  dimap :: (c -> a) -> (b -> d) -> p a b -> p c d
+  default dimap :: (Functor (p a),Cofunctor (Flip p d)) => (c -> a) -> (b -> d) -> p a b -> p c d
+  dimap f g = promap f . map g
+
+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) (map2 f subs)
+
+instance Functor Id where map f (Id a) = Id (f a)
+instance Applicative Id
+instance Monad Id where join (Id a) = a
+
+-- |The Constant Functor
+newtype Const a b = Const { getConst :: a }
+instance Semigroup a => Semigroup (Const a b) where Const a+Const b = Const (a+b)
+instance Monoid a => Monoid (Const a b) where zero = Const zero
+instance Functor (Const a) where map _ (Const a) = Const a
+instance Monoid a => Unit (Const a) where pure _ = Const zero
+instance Monoid a => Applicative (Const a) where
+  Const a <*> Const b = Const (a+b)
+
+-- |A motherflippin' functor
+newtype Flip f a b = Flip { unFlip :: f b a }
+                  deriving (Semigroup,Monoid)
+
+-- |The Composition functor
+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 (map2 f c)
+
+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
+instance Functor Maybe where map _ Nothing = Nothing; map f (Just a) = Just (f a)
+instance Functor ((,) b) where map f ~(b,a) = (b,f a)
+instance Functor ((->) a) where map = (.)
+deriving instance Functor Interleave
+deriving instance Functor OrdList
+
+instance Functor IO where map = P.fmap
+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
+infixr 3 <$>,<$
+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 ()
+void = (()<$)
+
+map2 :: (Functor f, Functor f') => (a -> b) -> f (f' a) -> f (f' b)
+map2 = map map map
+map3 :: (Functor f, Functor f', Functor f'') => (a -> b) -> f (f' (f'' a)) -> f (f' (f'' b))
+map3 = map map map2
+
+promap :: Cofunctor (Flip f c) => (a -> b) -> f b c -> f a c
+promap f c = unFlip (comap f (Flip c))
diff --git a/src/Algebra/Monad.hs b/src/Algebra/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad.hs
@@ -0,0 +1,23 @@
+module Algebra.Monad(
+  module Algebra.Monad.Base,
+
+  -- * Common monads
+  module Algebra.Monad.RWS,
+  module Algebra.Monad.State,
+  module Algebra.Monad.Reader,
+  module Algebra.Monad.Writer,
+  module Algebra.Monad.Cont,
+  module Algebra.Monad.Foldable,
+  module Algebra.Monad.Error
+  ) where
+
+import Algebra.Monad.Base
+
+import Algebra.Monad.RWS
+import Algebra.Monad.State
+import Algebra.Monad.Reader
+import Algebra.Monad.Writer
+import Algebra.Monad.Cont
+import Algebra.Monad.Foldable
+import Algebra.Monad.Error
+
diff --git a/src/Algebra/Monad/Base.hs b/src/Algebra/Monad/Base.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/Base.hs
@@ -0,0 +1,118 @@
+module Algebra.Monad.Base (
+  module Algebra.Classes,module Algebra.Applicative,module Algebra.Core,
+  module Algebra.Traversable,module Control.Lens,
+  
+  -- * Monad utilities
+  Kleisli(..),_Kleisli,
+  (=<<),joinMap,(<=<),(>=>),(>>),(<*=),only,return,
+  foldlM,foldrM,findM,while,until,
+  bind2,bind3,(>>>=),(>>>>=),
+  
+  -- * Instance utilities
+  Compose'(..),_Compose'
+  ) where
+
+import Algebra.Classes
+import Algebra.Applicative
+import Algebra.Core hiding (flip)
+import Algebra.Traversable
+import Control.Lens
+import qualified Control.Monad.Fix as Fix
+
+-- MonadFix instances
+instance MonadFix Id where mfix = cfix
+instance MonadFix ((->) b) where mfix = cfix
+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 (Traversable g,Monad f,Monad g) => Monad (f:.:g) where
+  join = Compose .map join.join.map sequence.getCompose.map getCompose
+instance (MonadFix f,Traversable g,Monad g) => MonadFix (f:.:g) where
+  mfix f = Compose $ mfix (map join . traverse (getCompose . f))
+instance Monad m => MonadTrans ((:.:) m) where
+  lift = Compose . pure
+  generalize = _Compose %%~ map (pure.yb _Id)
+
+instance MonadFix m => Monad (Backwards m) where
+  join (Backwards ma) = Backwards$mfixing (\a -> liftA2 (,) (forwards a) ma)
+instance MonadFix m => MonadFix (Backwards m) where
+  mfix f = by _Backwards $ mfix (yb _Backwards.f)
+instance MonadTrans Backwards where
+  lift = Backwards
+  generalize = _Backwards %%~ pure.yb _Id
+
+newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
+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 => Split (Kleisli m) where
+  Kleisli f <#> Kleisli g = Kleisli (\(a,c) -> (,)<$>f a<*>g c)
+instance Isomorphic (a -> m b) (c -> m' d) (Kleisli m a b) (Kleisli m' c d) where
+  _iso = iso Kleisli runKleisli
+
+cfix :: Contravariant c => (a -> c a) -> c a
+cfix = map fix . collect
+
+mfixing :: MonadFix f => (b -> f (a, b)) -> f a
+mfixing f = fst<$>mfix (\ ~(_,b) -> f 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 = yb i (foldMap (by 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)
+findM :: (Foldable t,Monad m) => (a -> m (Maybe b)) -> t a -> m (Maybe b)
+findM f = foldr fun (return Nothing)
+  where fun a b = maybe b (return . Just) =<< f a
+
+while :: Monad m => m Bool -> m ()
+while e = fix (\w -> e >>= bool w unit)
+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 =<<
+infixl 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
+only :: (Monoid (m ()),Monad m) => (a -> Bool) -> m a -> m a
+only p m = m <*= guard . p
+return :: Unit f => a -> f a
+return = pure
+
+joinMap :: Monad m => (a -> m b) -> m a -> m b
+joinMap = (=<<)
+
+newtype Compose' f g a = Compose' ((g:.:f) a)
+                       deriving (Semigroup,Monoid,Unit,Functor,Applicative,Monad,MonadFix,Foldable,Traversable)
+_Compose' :: Iso (Compose' f g a) (Compose' h i b) (g (f a)) (i (h b))
+_Compose' = _Compose.iso Compose' (\(Compose' c) -> c)
+instance Monad m => MonadTrans (Compose' m) where
+  lift = by _Compose' . map pure
+  generalize = _Compose' %%~ pure . yb _Id
+
+
+
diff --git a/src/Algebra/Monad/Cont.hs b/src/Algebra/Monad/Cont.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/Cont.hs
@@ -0,0 +1,34 @@
+module Algebra.Monad.Cont (
+  -- * The MonadCont class
+  MonadCont(..),
+  
+  -- * The Continuation transformer
+  ContT(..),Cont,
+  evalContT,
+  evalCont
+  ) where
+
+import Algebra.Monad.Base
+
+{-| A simple continuation monad implementation  -}
+newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
+                      deriving (Semigroup,Monoid,Ring)
+type Cont r a = ContT r Id a
+instance Unit m => Unit (ContT r m) where pure a = ContT ($a)
+instance Functor f => Functor (ContT r f) where
+  map f (ContT c) = ContT (\kb -> c (kb . f))
+instance Applicative m => Applicative (ContT r m) where
+  ContT cf <*> ContT ca = ContT (\kb -> cf (\f -> ca (\a -> kb (f a))))
+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 >>=)
+  generalize = undefined
+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
+
diff --git a/src/Algebra/Monad/Error.hs b/src/Algebra/Monad/Error.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/Error.hs
@@ -0,0 +1,40 @@
+module Algebra.Monad.Error (
+  -- * The MonadError class
+  MonadError(..),try,tryMay,throwIO,
+
+  -- * The Either transformer
+  EitherT,
+  _eitherT
+  ) where
+
+import Algebra.Monad.Base
+import qualified Control.Exception as Ex
+
+try :: MonadError Void m => m a -> m a -> m a
+try = catch . const
+tryMay :: MonadError e m => m a -> m (Maybe a)
+tryMay m = catch (\_ -> return Nothing) (Just<$>m)
+
+instance MonadError e (Either e) where
+  throw = Left
+  catch f = f<|>Right
+instance MonadError Void [] where
+  throw = const zero
+  catch f [] = f zero
+  catch _ l = l
+newtype EitherT e m a = EitherT (Compose' (Either e) m a)
+                      deriving (Unit,Functor,Applicative,Monad,MonadFix
+                               ,Foldable,Traversable,MonadTrans)
+_eitherT :: (Functor m) => Iso (EitherT e m a) (EitherT f m b) (m (e:+:a)) (m (f:+:b))                              
+_eitherT = _Compose'.iso EitherT (\(EitherT e) -> e)
+
+instance MonadError Void Maybe where
+  throw = const Nothing
+  catch f Nothing = f zero
+  catch _ a = a
+instance MonadError Ex.SomeException IO where
+  throw = Ex.throw
+  catch = flip Ex.catch
+throwIO :: Ex.Exception e => e -> IO ()
+throwIO = throw . Ex.toException
+
diff --git a/src/Algebra/Monad/Foldable.hs b/src/Algebra/Monad/Foldable.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/Foldable.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.Foldable (
+  -- * The MonadList class
+  MonadList(..),
+  
+  -- * Foldable monads transformers
+  -- ** The List transformer
+  ListT,_listT,
+  -- ** The Tree transformer
+  TreeT(..),_TreeT,
+  -- ** The Maybe transformer
+  MaybeT(..),_MaybeT
+  ) where
+
+import Algebra.Monad.Base
+import Algebra.Monad.RWS
+import Data.Tree (Tree(..))
+
+instance MonadList [] where fork = id
+
+newtype ListT m a = ListT (Compose' [] m a)
+                    deriving (Semigroup,Monoid,
+                              Functor,Applicative,Unit,Monad,
+                              Foldable,Traversable,MonadTrans)
+_listT :: Iso (ListT m a) (ListT m' a') (m [a]) (m' [a'])
+_listT = _Compose'.iso ListT (\(ListT l) -> l)
+instance Monad m => MonadList (ListT m) where
+  fork = by _listT . return 
+instance MonadFix m => MonadFix (ListT m) where
+  mfix f = by _listT (mfix (yb _listT . f . head))
+instance MonadState s m => MonadState s (ListT m) where
+  get = get_ ; modify = modify_ ; put = put_
+instance MonadWriter w m => MonadWriter w (ListT m) where
+  tell = lift.tell
+  listen = _listT-.map sequence.listen.-_listT
+  censor = _listT-.censor.map (\l -> (fst<$>l,compose (snd<$>l))).-_listT
+instance Monad m => MonadError Void (ListT m) where
+  throw = const zero
+  catch f mm = mm & _listT %%~ (\m -> m >>= \_l -> case _l of
+                                   [] -> f zero^.._listT; l -> pure l)
+
+newtype TreeT m a = TreeT (Compose' Tree m a)
+                  deriving (Functor,Unit,Applicative,Monad,MonadFix,
+                            Foldable,Traversable,MonadTrans)
+_TreeT :: Iso (TreeT m a) (TreeT n b) (m (Tree a)) (n (Tree b))
+_TreeT = _Compose'.iso TreeT (\(TreeT t) -> t)
+newtype MaybeT m a = MaybeT (Compose' Maybe m a)
+                  deriving (Functor,Unit,Applicative,Monad,MonadFix,
+                            Foldable,Traversable,MonadTrans)
+_MaybeT :: Iso (MaybeT m a) (MaybeT m' b) (m (Maybe a)) (m' (Maybe b))
+_MaybeT = _Compose'.iso MaybeT (\(MaybeT m) -> m)
+
+
diff --git a/src/Algebra/Monad/RWS.hs b/src/Algebra/Monad/RWS.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/RWS.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.RWS (
+  RWST(..),RWS,MonadInternal(..),_RWST,
+
+  -- * Default methods
+  get_,put_,modify_,local_,ask_,tell_,listen_,censor_
+  ) where
+
+import Algebra.Monad.Base
+
+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
+
+-- Instances
+instance (Unit f,Monoid w) => Unit (RWST r w s f) where
+  pure a = RWST (\ ~(_,s) -> pure (a,s,zero))
+instance Functor f => Functor (RWST r w s f) where
+  map f (RWST fa) = RWST (fa >>> map (\ ~(a,s,w) -> (f a,s,w)))
+instance (Monoid w,Monad m) => Applicative (RWST r w s m)
+instance (Monoid w,Monad m) => Monad (RWST r w s m) where
+  join mm = RWST (\ ~(r,s) -> do
+                     ~(m,s',w) <- runRWST mm (r,s)
+                     ~(a,s'',w') <- runRWST m (r,s')
+                     return (a,s'',w+w'))
+instance (Monoid w,MonadFix m) => MonadFix (RWST r w s m) where
+  mfix f = RWST (\x -> mfix (\ ~(a,_,_) -> runRWST (f a) x))
+instance (Monoid w,MonadCont m) => MonadCont (RWST r w s m) where
+  callCC f = RWST $ \(r,s) ->
+    callCC $ \k -> runRWST (f (\a -> lift (k (a,s,zero)))) (r,s)
+deriving instance Semigroup (m (a,s,w)) => Semigroup (RWST r w s m a)
+deriving instance Monoid (m (a,s,w)) => Monoid (RWST r w s m a)
+deriving instance Ring (m (a,s,w)) => Ring (RWST r w s m a)
+instance (Monad m,Monoid w) => MonadState s (RWST r w s m) where
+  get = RWST (\ ~(_,s) -> pure (s,s,zero) )
+  put s = RWST (\ _ -> pure ((),s,zero) )
+  modify f = RWST (\ ~(_,s) -> pure ((),f s,zero) )
+instance (Monad m,Monoid w) => MonadReader r (RWST r w s m) where
+  ask = RWST (\ ~(r,s) -> pure (r,s,zero) )
+  local f (RWST m) = RWST (\ ~(r,s) -> m (f r,s) )
+instance (Monad m,Monoid w) => MonadWriter w (RWST r w s m) where
+  tell w = RWST (\ ~(_,s) -> pure ((),s,w) )
+  listen (RWST m) = RWST (m >>> map (\ ~(a,s,w) -> ((w,a),s,w) ) )
+  censor (RWST m) = RWST (m >>> map (\ ~(~(a,f),s,w) -> (a,s,f w) ) )
+instance Foldable m => Foldable (RWST Void w Void m) where
+  fold (RWST m) = foldMap (\(w,_,_) -> w).m $ (zero,zero)
+instance Traversable m => Traversable (RWST Void w Void m) where
+  sequence (RWST m) = map (RWST . const . map (\((s,w),a) -> (a,s,w)))
+                      . sequence . map (\(a,s,w) -> sequence ((s,w),a))
+                      $ m (zero,zero)
+instance (Monoid w,MonadError e m) => MonadError e (RWST r w s m) where
+  throw = lift.throw
+  catch f (RWST m) = RWST (\x -> catch (flip runRWST x.f) (m x))
+instance (Monoid w,MonadList m) => MonadList (RWST r w s m) where
+  fork = lift . fork
+instance Monoid w => MonadTrans (RWST r w s) where
+  lift m = RWST (\ ~(_,s) -> (,s,zero) <$> m)
+  generalize (RWST s) = RWST (\x -> pure (s x^.._Id))
+instance (Monoid w) => MonadInternal (RWST r w s) where
+  internal f (RWST m) = RWST (\ x -> f (m x <&> \ ~(a,s,w) -> ((s,w),a) )
+                                     <&> \ ~((s,w),b) -> (b,s,w) )
+  
+class MonadTrans t => MonadInternal t where
+  internal :: Monad m => (forall c. m (c,a) -> m (c,b)) ->
+              (t m a -> t m b)
+
+_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
+
+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  
+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)
+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)))
+
diff --git a/src/Algebra/Monad/Reader.hs b/src/Algebra/Monad/Reader.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/Reader.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.Reader (
+  -- *** The Reader monad
+  MonadReader(..),
+  ReaderT,Reader,
+  _readerT,_reader,
+  ) where
+
+import Algebra.Monad.Base
+import Algebra.Monad.RWS
+
+instance MonadReader r ((->) r) where
+  ask = id ; local = (>>>)
+
+{-| A simple Reader monad -}
+newtype ReaderT r m a = ReaderT (RWST r Void Void m a) 
+                      deriving (Functor,Unit,Applicative,Monad,MonadFix,
+                                MonadTrans,MonadInternal,
+                                MonadReader r,MonadCont,MonadList)
+type Reader r a = ReaderT r Id a
+
+instance MonadState s m => MonadState s (ReaderT r m) where
+  get = get_ ; put = put_ ; modify = modify_
+instance MonadWriter w m => MonadWriter w (ReaderT r m) where
+  tell = tell_ ; listen = listen_ ; censor = censor_
+deriving instance Semigroup (m (a,Void,Void)) => Semigroup (ReaderT r m a)
+deriving instance Monoid (m (a,Void,Void)) => Monoid (ReaderT r m a)
+deriving instance Ring (m (a,Void,Void)) => Ring (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<&>(,zero,zero) ))
+        runReaderT (ReaderT (RWST f)) r = f (r,zero) <&> \ ~(a,_,_) -> a
+_reader :: Iso (Reader r a) (Reader r' b) (r -> a) (r' -> b)
+_reader = _mapping _Id._readerT
+
diff --git a/src/Algebra/Monad/State.hs b/src/Algebra/Monad/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/State.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.State (
+  -- * The State Monad
+  MonadState(..),
+  StateT,State,
+  stateT,eval,exec,state,
+  (=~),(=-),gets,saving,
+  Next,Prev,
+  mapAccum,mapAccum_,mapAccumR,mapAccumR_,push,pop,withPrev,withNext,
+
+  -- * The State Arrow
+  StateA(..),stateA,
+  ) where
+
+import Algebra.Monad.RWS
+import Algebra.Monad.Base
+
+instance MonadState (IO ()) IO where
+  get = return unit
+  put a = a
+  modify f = put (f unit)
+
+newtype StateT s m a = StateT (RWST Void Void s m a)
+                     deriving (Unit,Functor,Applicative,Monad,MonadFix,
+                               MonadTrans,MonadInternal,
+                               MonadCont,MonadState s,MonadList)
+type State s a = StateT s Id a
+instance MonadReader r m => MonadReader r (StateT s m) where
+  ask = ask_ ; local = local_
+instance MonadWriter w m => MonadWriter w (StateT s m) where
+  tell = tell_ ; listen = listen_ ; censor = censor_
+deriving instance MonadError e m => MonadError e (StateT s m)
+deriving instance Semigroup (m (a,s,Void)) => Semigroup (StateT s m a)
+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 (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,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 :: (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 ()
+infixl 0 =-,=~
+l =- x = modify (set l x)
+(=~) :: MonadState s m => Lens' s s' -> (s' -> s') -> m ()
+l =~ f = modify (warp l f)
+gets :: MonadState s m => Lens' s s' -> m s'
+gets l = by l<$>get
+
+saving :: MonadState s m => Lens' s s' -> m a -> m a
+saving l st = gets l >>= \s -> st <* (l =- s)
+
+-- * The State Arrow
+newtype StateA m s a = StateA (StateT s m a)
+stateA :: Iso (StateA m s a) (StateA m' s' a') (StateT s m a) (StateT s' m' a')
+stateA = iso StateA (\(StateA s) -> s)
+instance Monad m => Category (StateA m) where
+  id = StateA get
+  StateA sbc . StateA sab = StateA $ (^.stateT) $ \a ->
+    (sab^..stateT) a >>= \(a',b) -> (a',).snd <$> (sbc^..stateT) b
+instance Monad m => Split (StateA m) where
+  StateA sac <#> StateA sbd = StateA $ (^.stateT)
+                              $ map2 (\((a',c),(b',d)) -> ((a',b'),(c,d)))
+                              $ (Kleisli (sac^..stateT) <#> Kleisli (sbd^..stateT)) ^.. _Kleisli
+instance Monad m => Choice (StateA m) where
+  StateA sac <|> StateA sbc = StateA $ (^.stateT) $
+                              l Left (sac^..stateT)<|>l Right (sbc^..stateT)
+    where l = map2 . first
+
+mapAccum :: Traversable t => (a -> s -> (s, b)) -> t a -> s -> (s, t b)
+mapAccum f t = traverse (by 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 (by (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_ (,)
+
+type Next a = a
+type Prev a = a
+withPrev :: Traversable t => a -> t a -> t (Prev a,a)
+withPrev = flip (mapAccum_ (\a p -> (a,(p,a))))
+withNext :: Traversable t => t a -> a -> t (a,Next a)
+withNext = mapAccumR_ (\a p -> (a,(a,p)))
diff --git a/src/Algebra/Monad/Writer.hs b/src/Algebra/Monad/Writer.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Monad/Writer.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.Writer (
+    -- * The Writer monad
+  MonadWriter(..),
+  mute,intercept,
+
+  -- * The Writer transformer
+  WriterT,Writer,
+  _writerT,_writer
+  ) where
+
+import Algebra.Monad.Base
+import Algebra.Monad.RWS
+
+instance Monoid w => MonadWriter w ((,) w) where
+  tell w = (w,())
+  listen m@(w,_) = (w,m)
+  censor ~(w,~(a,f)) = (f w,a)
+  
+mute :: (MonadWriter w m,Monoid w) => m a -> m a
+mute m = censor (m<&>(,const zero))
+intercept :: (MonadWriter w m,Monoid w) => m a -> m (w,a)
+intercept = listen >>> mute
+
+{-| A simple Writer monad -}
+newtype WriterT w m a = WriterT (RWST Void w Void m a)
+                      deriving (Unit,Functor,Applicative,Monad,MonadFix
+                               ,Foldable,Traversable
+                               ,MonadTrans,MonadInternal
+                               ,MonadWriter w,MonadCont,MonadList)
+type Writer w a = WriterT w Id a
+instance (Monoid w,MonadReader r m) => MonadReader r (WriterT w m) where
+  ask = ask_ ; local = local_
+instance (Monoid w,MonadState r m) => MonadState r (WriterT w m) where
+  get = get_ ; put = put_ ; modify = modify_
+deriving instance Semigroup (m (a,Void,w)) => Semigroup (WriterT w m a)
+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,Functor m') => Iso (WriterT w m a) (WriterT w' m' b) (m (w,a)) (m' (w',b))
+_writerT = iso writerT runWriterT
+  where writerT mw = WriterT (RWST (pure (mw <&> \ ~(w,a) -> (a,zero,w) )))
+        runWriterT (WriterT (RWST m)) = m (zero,zero) <&> \ ~(a,_,w) -> (w,a)
+_writer :: Iso (Writer w a) (Writer w' b) (w,a) (w',b)
+_writer = _Id._writerT
+
+
diff --git a/src/Algebra/Traversable.hs b/src/Algebra/Traversable.hs
new file mode 100644
--- /dev/null
+++ b/src/Algebra/Traversable.hs
@@ -0,0 +1,57 @@
+module Algebra.Traversable(
+  module Algebra.Applicative, module Algebra.Foldable,
+
+  Traversable(..),Contravariant(..),
+
+  traverse,foreach,transpose,flip
+  ) where
+
+import Algebra.Classes
+import Algebra.Core hiding (flip,(&))
+import Algebra.Applicative
+import Algebra.Foldable
+import Control.Lens
+import Data.Tree
+
+class Foldable t => Traversable t where
+  sequence :: Applicative f => t (f a) -> f (t a)
+instance Traversable ((,) c) where
+  sequence ~(c,m) = (,) c<$>m
+instance Traversable (Either a) where
+  sequence = pure . Left <|> map Right
+instance Traversable [] where
+  sequence (x:xs) = (:)<$>x<*>sequence xs
+  sequence [] = pure []
+deriving instance Traversable Interleave
+deriving instance Traversable OrdList
+deriving instance Traversable ZipList
+instance Traversable Tree where
+  sequence (Node a subs) = Node<$>a<*>sequence (map sequence subs)
+deriving instance Traversable ZipTree
+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
+instance Traversable Maybe where
+  sequence Nothing = pure Nothing
+  sequence (Just a) = Just<$>a
+
+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
+  _each = traverse
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Lens.hs
@@ -0,0 +1,296 @@
+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies, ViewPatterns, TupleSections #-}
+{-|
+A module providing simple Lens functionality.
+
+Lenses are a Haskell abstraction that allows you to access and modify
+part of a structure, compensating for and improving upon Haskell's
+horrendous record syntax and giving Haskell a first-class record system.
+
+This module defines three kinds of Lenses : Lenses that allow you to
+access part of a structure; Traversals that allow you to modify part
+of a structure; and Isos which may be reversed. Lenses of any kind can
+be composed with @(.)@, yielding a Lens of the most general kind, so
+that composing a Lens with a Traversal or Iso yields a Lens, and a
+Traversal with an Iso yields a Traversal.
+-}
+module Control.Lens(
+  -- * The lens types
+  Iso,Iso',(:<->:),
+  LensLike,LensLike',
+  Fold,Fold',
+  Getter,Getter',
+  Lens,Lens',
+  Traversal,Traversal',
+
+  -- * Constructing lenses
+  iso,from,lens,getter,prism,sat,simple,(.+),
+
+  -- * Extracting values
+  (^.),(^..),(^?),has,(^??),(%~),(%-),(%%~),(%%-),by,yb,warp,set,
+  (-.),(.-),
+  
+  -- * Basic lenses
+  Lens1(..),Lens2(..),Lens3(..),Lens4(..),
+  Trav1(..),Trav2(..),
+  Compound(..),
+  _list,_head,_tail,
+
+  -- * Isomorphisms
+  Isomorphic(..),
+  adding,_swapped,
+  _Id,_OrdList,_Const,_Dual,_Endo,_Flip,_maybe,_Max,_Compose,_Backwards,
+  warp2,_mapping,_mapping',_promapping,
+  IsoFunctor(..),(<.>),IsoFunctor2(..),
+  _thunk
+  ) where
+
+import Algebra.Core
+import Algebra.Functor
+import Algebra.Applicative
+import System.IO.Unsafe (unsafePerformIO)
+import Control.Exception (evaluate)
+
+type LensLike f s t a b = (s -> f t) -> (a -> f b)
+type LensLike' f a b = LensLike f b b a a
+
+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' 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 Fold s t a b = forall f. (Semigroup (f b),Applicative f) => LensLike f s t a b
+type Fold' a b = Fold 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)
+type Iso' a b = Iso b b a a
+type a :<->: b = Iso' a b
+
+data IsoT a b s t = IsoT (s -> a) (b -> t)
+instance Functor (IsoT a b s) where map f (IsoT u v) = IsoT u (map f v)
+instance Cofunctor (Flip (IsoT a b) t) where
+  comap f (Flip (IsoT u v)) = Flip (IsoT (promap f u) v)
+instance Bifunctor (IsoT a b)
+
+-- |Create an 'Iso' from two inverse functions.
+iso :: (a -> s) -> (t -> b) -> Iso s t a b
+iso f g = dimap f (map g)
+isoT :: Iso s t a b -> IsoT s t a b
+isoT i = getId<$>i (IsoT id Id)
+unIsoT :: IsoT s t a b -> Iso s t a b
+unIsoT (IsoT u v) = iso u v
+-- |Reverse an 'Iso'
+--
+-- @
+-- from :: 'Iso'' a b -> 'Iso'' b a
+-- @
+from :: Iso s t a b -> Iso b a t s
+from = isoT >>> (\ ~(IsoT u v) -> IsoT v u) >>> unIsoT
+-- |Create a 'Lens' from a getter and setter function.
+-- 
+-- @
+-- lens :: (a -> b) -> (a -> b -> a) -> 'Lens'' a b
+-- @
+lens :: (a -> s) -> (a -> t -> b) -> Lens s t a b
+lens f g = \k a -> g a <$> k (f a) 
+
+getter :: (a -> b) -> Traversal' a b
+getter f = \k a -> a<$k (f a)
+
+-- |Create a 'Traversal' from a maybe getter and setter function.
+--
+-- @
+-- prism :: (a -> (a:+:b)) -> (a -> b -> a) -> 'Traversal'' a b
+-- @
+prism :: (a -> (b:+:s)) -> (a -> t -> b) -> Traversal s t a b 
+prism f g = \k a -> (pure <|> map (g a) . k) (f a)
+
+sat :: (a -> Bool) -> Traversal' a a
+sat p = \k a -> (if p a then k else pure) a
+
+(.+) :: Fold s t a b -> Fold s t a b -> Fold s t a b
+f .+ f' = \k a -> f k a + f' k a
+infixr 8 .+
+
+-- |Retrieve a value from a structure using a 'Lens' (or 'Iso')
+infixl 8 ^.,^..,^?,^??,%~,%-,%%~,%%-
+(^.) :: a -> Getter b b a a -> b
+(^.) = flip by
+(^..) :: a -> Iso a a b b -> b
+(^..) = flip yb
+-- |
+(%~) :: 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 -> Fold' a b -> f b
+x^?l = getConst $ l (Const . pure) x
+(^??) :: a -> ((b -> Const [b] b) -> a -> Const [b] a) -> [b]
+x^??l = getConst $ l (Const . pure) x
+
+simple :: Iso' a b -> Iso' a b
+simple i = i
+
+(-.) :: Getter c u b v -> (a -> b) -> a -> c
+l-.f = by l.f
+(.-) :: (b -> c) -> Iso a a b b -> a -> c
+f.-i = f.yb i
+infixr 9 -.,.-
+by :: Getter b u a v -> a -> b
+by l = getConst . l Const
+yb :: Iso s t a b -> t -> b
+yb i = by (from i)
+warp :: Traversal s t a b -> (s -> t) -> (a -> b)
+warp l = map getId . l . map Id
+set :: Traversal s t a b -> t -> (a -> b)
+set l = warp l . const 
+
+class Lens1 s t a b | a -> s, a t -> b where
+  _1 :: Lens s t a b
+class Lens2 s t a b | a -> s, a t -> b where
+  _2 :: Lens s t a b
+class Lens3 s t a b | a -> s, a t -> b where
+  _3 :: Lens s t a b
+class Lens4 s t a b | a -> s, a t -> b where
+  _4 :: Lens s t a b
+class Trav1 s t a b | a -> s, a t -> b where
+  _l :: Traversal s t a b
+class Trav2 s t a b | a -> s, a t -> b where
+  _r :: Traversal s t a b
+instance Lens1 a b (a:*:c) (b:*:c) where
+  _1 = lens fst (flip (first . const))
+instance Lens1 a b (a,c,d) (b,c,d) where
+  _1 = lens (\ ~(a,_,_) -> a) (\ (_,c,d) b -> (b,c,d))
+instance Lens1 a b (a,c,d,e) (b,c,d,e) where
+  _1 = lens (\ ~(a,_,_,_) -> a) (\ (_,c,d,e) b -> (b,c,d,e))
+instance Lens2 a b (c:*:a) (c:*:b) where
+  _2 = lens snd (flip (second . const))
+instance Lens2 a b (c,a,d) (c,b,d) where
+  _2 = lens (\ ~(_,a,_) -> a ) (\ ~(c,_,d) b -> (c,b,d))
+instance Lens2 a b (c,a,d,e) (c,b,d,e) where
+  _2 = lens (\ ~(_,a,_,_) -> a ) (\ ~(c,_,d,e) b -> (c,b,d,e))
+instance Lens3 a b (c,d,a) (c,d,b) where
+  _3 = lens (\ ~(_,_,a) -> a ) (\ ~(c,d,_) b -> (c,d,b))
+instance Lens3 a b (c,d,a,e) (c,d,b,e) where
+  _3 = lens (\ ~(_,_,a,_) -> a ) (\ ~(c,d,_,e) b -> (c,d,b,e))
+instance Lens4 a b (c,d,e,a) (c,d,e,b) where
+  _4 = lens (\ ~(_,_,_,a) -> a ) (\ ~(c,d,e,_) b -> (c,d,e,b))
+instance Trav1 a b (a:+:c) (b:+:c) where
+  _l = prism ((id ||| Right) >>> swapE) (flip (left . const))
+    where swapE :: (b:+:a) -> (a:+:b)
+          swapE = Right<|>Left
+instance Trav2 a b (c:+:a) (c:+:b) where
+  _r = prism (Left ||| id) (flip (right . const))
+instance Trav2 a b (Maybe a) (Maybe b) where
+  _r = prism (\a -> maybe (Left Nothing) Right a) (flip (<$))
+
+class Compound a b s t | s -> a, b s -> t where
+  _each :: Traversal a b s t
+instance Compound a b (a,a) (b,b) where
+  _each k (a,a') = (,)<$>k a<*>k a'
+instance Compound a b (a,a,a) (b,b,b) where
+  _each k (a,a',a'') = (,,)<$>k a<*>k a'<*>k a''
+instance Compound a b (a:+:a) (b:+:b) where
+  _each k = map Left . k <|> map Right . k
+_list :: [a] :<->: (():+:(a:*:[a]))
+_list = iso (\l -> case l of
+                [] -> Left ()
+                (x:t) -> Right (x,t)) (const [] <|> uncurry (:))
+
+_head :: Traversal' [a] a
+_head = _list._r._1
+_tail :: Traversal' [a] [a]
+_tail = _list._r._2
+
+_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)
+
+class Isomorphic b a t s | t -> b, t a -> s where
+  _iso :: Iso s t a b
+instance Isomorphic a b (Id a) (Id b) where
+  _iso = iso Id getId
+instance Isomorphic [a] [b] (OrdList a) (OrdList b) where
+  _iso = iso OrdList getOrdList
+instance Isomorphic a b (Const a c) (Const b c) where
+  _iso = iso Const getConst
+instance Isomorphic a b (Dual a) (Dual b) where
+  _iso = iso Dual getDual
+instance Isomorphic a b (Max a) (Max b) where
+  _iso = iso Max getMax
+instance Isomorphic (k a a) (k b b) (Endo k a) (Endo k b) where
+  _iso = iso Endo runEndo
+instance Isomorphic (f a b) (f c d) (Flip f b a) (Flip f d c) where
+  _iso = iso Flip unFlip
+instance Isomorphic Bool Bool (Maybe a) (Maybe Void) where
+  _iso = iso (bool (Just zero) Nothing) (maybe False (const True))
+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 (zero,) snd
+_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 (Maybe Void) (Maybe a) Bool Bool
+_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 g b) (f a) (g 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 f = \a a' -> yb i (by i a`f`by i a')
+
+class IsoFunctor f where
+  mapIso :: Iso s t a b -> Iso (f s) (f t) (f a) (f b)
+class IsoFunctor2 f where
+  mapIso2 :: (a:<->:c) -> (b:<->:d) -> (f a b:<->:f c d)
+
+-- | An infix synonym for 'mapIso2'
+(<.>) :: IsoFunctor2 f => (a:<->:c) -> (b:<->:d) -> (f a b:<->:f c d)
+(<.>) = mapIso2
+infixr 9 <.>
+
+instance IsoFunctor ((->) a) where mapIso = _mapping
+instance IsoFunctor2 (->) where mapIso2 i j = _promapping i._mapping j
+instance IsoFunctor2 (,) where
+  mapIso2 i j = iso (by i <#> by j) (yb i <#> yb j)
+instance IsoFunctor2 Either where
+  mapIso2 i j = iso (by i ||| by j) (yb i ||| yb j)
+
+adding :: (Num n,Semigroup n) => n -> Iso' n n
+adding n = iso (+n) (subtract n)
+
+_thunk :: Iso a b (IO a) (IO b)
+_thunk = iso unsafePerformIO evaluate
+
+_swapped :: Iso (a,b) (c,d) (b,a) (d,c)
+_swapped = iso (\(b,a) -> (a,b)) (\(c,d) -> (d,c))
+
+newtype Test a = Test (Const (Product Bool) a)
+               deriving (Semigroup,Monoid,Functor,Unit
+                        ,Applicative)
+has :: Fold' a b -> a -> Bool
+has l x = x^?l & \(Test (Const (Product b))) -> b
+
+
diff --git a/src/Control/Parser.hs b/src/Control/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Parser.hs
@@ -0,0 +1,200 @@
+-- |A module providing simple Parser combinator functionality. Useful
+-- for small parsing tasks such as identifier parsing or command-line
+-- argument parsing
+module Control.Parser (
+  module SimpleH,
+  -- * The ParserT Type
+  ParserT(..),Parser,ParserA(..),_ParserA,
+
+  -- ** The Stream class
+  Stream(..),emptyStream,
+
+  -- ** Converting to/from Parsers
+  parserT,parser,runParser,runParserT,pureParser,eitherParser,
+
+  -- * Basic combinators
+  (<+>),(>*>),(<*<),
+  token,satisfy,
+  oneOf,noneOf,single,
+  several,
+  remaining,eoi,
+
+  -- ** Specialized utilities
+  readable,number,digit,letter,alNum,quotedString,space,spaces,eol,
+  
+  -- * Basic combinators
+  many,many1,sepBy,sepBy1,
+  chainl,chainr                          
+  ) where
+
+import SimpleH
+
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+
+newtype ParserT w s m a = ParserT (StateT s (ListT (WriterT w m)) a)
+                        deriving (Unit,Functor,Applicative,Monoid,Semigroup,
+                                  Monad,MonadFix,MonadState s,MonadWriter w)
+type Parser w c a = ParserT w c Id a
+deriving instance (Monad m,Monoid w) => MonadError Void (ParserT w c m)
+instance Monoid w => MonadTrans (ParserT w s) where
+  lift = ParserT . lift . lift . lift
+  generalize = parserT %%~ map (pure.yb _Id)
+_ParserT :: Iso (ParserT w s m a) (ParserT x t n b) (StateT s (ListT (WriterT w m)) a) (StateT t (ListT (WriterT x n)) b)
+_ParserT = iso ParserT (\(ParserT p) -> p)
+parserT :: (Functor n,Functor m) => Iso (ParserT w s m a) (ParserT x t n b) (s -> m (w,[(s,a)])) (t -> n (x,[(t,b)]))
+parserT = _mapping (_writerT._listT).stateT._ParserT
+parser :: Iso (Parser w s a) (Parser x t b) (s -> (w,[(s,a)])) (t -> (x,[(t,b)]))
+parser = _mapping _Id.parserT
+runParser :: Parser Void s a -> s -> [(s,a)]
+runParser = map snd . yb parser
+runParserT :: Functor m => ParserT Void s m a -> s -> m [(s,a)]
+runParserT = map2 snd . (^..parserT)
+pureParser :: (Monoid w,Monad m) => (s -> [a]) -> ParserT w s m a
+pureParser p = (\a -> pure (zero,[(a,b) | b <- p a]))^.parserT
+eitherParser :: Monoid w => (s -> Either w a) :<->: Parser w s a
+eitherParser = iso (\p s -> (,[])<|>pure.pure.(s,) $ p s)
+               (\p' s -> case p' s of
+                   (w,[]) -> Left w
+                   (_,((_,a):_)) -> Right a).parser
+               
+  
+-- |The @(+)@ operator with lower priority
+(<+>) :: Semigroup m => m -> m -> m
+(<+>) = (+)
+(>*>) :: (Monoid w, Monad m) => ParserT w a m b -> ParserT w b m c -> ParserT w a m c
+(>*>) = (>>>)^..(_ParserA<.>_ParserA<.>_ParserA)
+(<*<) :: (Monoid w, Monad m) => ParserT w b m c -> ParserT w a m b -> ParserT w a m c
+(<*<) = flip (>*>)
+
+newtype ParserA w m s a = ParserA (ParserT w s m a)
+_ParserA :: Iso (ParserA w m s a) (ParserA w' m' s' a') (ParserT w s m a) (ParserT w' s' m' a')
+_ParserA = iso ParserA (\(ParserA p) -> p)
+parserA :: Iso (ParserA w m s a) (ParserA w' m' s' a') (StateA (ListT (WriterT w m)) s a) (StateA (ListT (WriterT w' m')) s' a') 
+parserA = from stateA._ParserT._ParserA
+instance (Monoid w,Monad m) => Category (ParserA w m) where
+  id = ParserA get
+  (.) = (.)^.(parserA<.>parserA<.>parserA)
+instance (Monoid w,Monad m) => Split (ParserA w m) where
+  (<#>) = (<#>)^.(parserA<.>parserA<.>parserA)
+instance (Monoid w,Monad m) => Choice (ParserA w m) where
+  (<|>) = (<|>)^.(parserA<.>parserA<.>parserA)
+instance (Monoid w,Monad m) => Arrow (ParserA w m) where
+  arr f = arr f^.parserA
+
+-- |The remaining Stream to parse
+remaining :: (Monad m,Monoid w) => ParserT w s m s
+remaining = get
+-- |Consume a token from the Stream
+token :: (Monad m,Monoid w,Stream c s) => ParserT w s m c
+{-# SPECIALIZE token :: (Monad m,Monoid w) => ParserT w [c] m c #-}
+token = get >>= \s -> case uncons s of
+  Nothing -> zero
+  Just (c,t) -> put t >> pure c
+
+-- |Parse zero, one or more successive occurences of a parser.
+many :: (Monoid w,Monad m) => ParserT w c m a -> ParserT w c m [a]
+many p = liftA2 (:) p (many p) <+> pure []
+-- |Parse one or more successiveé occurences of a parser.
+many1 :: (Monoid w,Monad m) => ParserT w c m a -> ParserT w c m [a]
+many1 p = (:)<$>p<*>many p
+
+-- |Consume a token and succeed if it verifies a predicate
+satisfy :: (Monoid w, Monad m, Stream c s) => (c -> Bool) -> ParserT w s m c
+{-# SPECIALIZE satisfy :: (Monoid w, Monad m) => (c -> Bool) -> ParserT w [c] m c #-}
+satisfy p = token <*= guard . p
+-- |Consume a single fixed token or fail.
+single :: (Eq c, Monoid w, Monad m, Stream c s) => c -> ParserT w s m ()
+single = void . satisfy . (==)
+
+-- |Consume a structure of characters or fail
+several :: (Eq c, Monoid w, Monad m, Foldable t, Stream c s) => t c -> ParserT w s m ()
+{-# SPECIALIZE several :: (Eq c, Monoid w, Monad m) => [c] -> ParserT w [c] m () #-}
+several l = traverse_ single l
+
+-- |Try to consume a parser. Return a default value when it fails.
+option :: (Monoid w,Monad m) => a -> ParserT w s m a -> ParserT w s m a
+option a p = p+pure a
+
+-- |Succeed only if we are by the End Of Input.
+eoi :: (Monad m,Monoid w,Stream c s) => ParserT w s m ()
+eoi = remaining >>= guard.emptyStream
+-- |The end of line
+eol :: (Monad m,Monoid w,Stream Char s) => ParserT w s m ()
+eol = single '\n'
+
+-- |Parse one or more successive occurences of a parser separated by
+-- occurences of a second parser.
+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)
+-- |Parse zero or more successive occurences of a parser separated by
+-- occurences of a second parser.
+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)
+
+-- |Parse a member of a set of values
+oneOf :: (Eq c, Monoid w, Monad m, Foldable t, Stream c s) => t c -> ParserT w s m c
+oneOf = satisfy . flip elem
+-- |Parse anything but a member of a set
+noneOf :: (Eq c, Monoid w, Monad m, Foldable t, Stream c s) => t c -> ParserT w s m c
+noneOf = satisfy . map not . flip elem
+
+-- |Parse a litteral decimal number
+number :: (Monoid w,Monad m,Stream Char s,Num n) => ParserT w s m n
+number = fromInteger.read <$> many1 digit
+-- |Parse a single decimal digit
+digit :: (Monoid w,Monad m,Stream Char s) => ParserT w s m Char
+digit = satisfy isDigit
+alNum :: (Monoid w,Monad m,Stream Char s) => ParserT w s m Char
+alNum = satisfy isAlphaNum
+letter :: (Monoid w,Monad m,Stream Char s) => ParserT w s m Char
+letter = satisfy isAlpha
+-- |Parse a delimited string, unsing '\\' as the quoting character
+quotedString :: (Monoid w,Monad m,Stream Char s) => Char -> ParserT w s m String
+quotedString d = between (single d) (single d) (many ch)
+  where ch = single '\\' *> unquote<$>token
+             <+> noneOf (d:"\\")
+        unquote 'n' = '\n'
+        unquote 't' = '\t'
+        unquote c = c
+-- |A single space
+space :: (Monoid w,Monad m,Stream Char s) => ParserT w s m Char
+space = satisfy isSpace
+-- |Many spaces
+spaces :: (Monoid w,Monad m,Stream Char s) => ParserT w s m String
+spaces = many1 space
+
+infixl 1 `sepBy`,`sepBy1`
+infixr 0 <+>
+
+-- |Chain an operator with an initial value and several tail values.
+chainr :: (Monoid w,Stream c s,Monad m) => ParserT w s m a -> ParserT w s m (b -> a -> a) -> ParserT w s m b -> ParserT w s m a
+chainr expr op e = compose<$>many (op<**>e)<*>expr
+-- |Chain an operator with an initial value
+chainl :: (Monoid w,Stream c s,Monad m) => ParserT w s m a -> ParserT w s m (a -> b -> a) -> ParserT w s m b -> ParserT w s m a
+chainl expr op e = compose<$>many (flip<$>op<*>e)<**>expr
+
+class Stream c s | s -> c where
+  uncons :: s -> Maybe (c,s)
+  cons :: c -> s -> s
+instance Stream a [a] where
+  uncons [] = Nothing
+  uncons (x:xs) = Just (x,xs)
+  cons = (:)
+instance Stream Char BS.ByteString where
+  uncons = BS.uncons
+  cons = BS.cons
+
+-- |Test if a Stream is empty
+emptyStream :: Stream c s => s -> Bool
+emptyStream = maybe True (const False) . uncons
+
+class Serializable t where
+  encode :: t -> BS.ByteString
+  decode :: Parser String BS.ByteString t
+instance Serializable BS.ByteString where
+  encode = id ; decode = get
+
+readable :: (Monoid w,Monad m,Read a) => ParserT w String m a 
+readable = map (pure.pure.map swap) (readsPrec 0)^.parserT
+
diff --git a/src/Control/Parser/CmdArgs.hs b/src/Control/Parser/CmdArgs.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Parser/CmdArgs.hs
@@ -0,0 +1,47 @@
+module Control.Parser.CmdArgs (
+  -- * Exported modules
+  module Control.Parser,
+
+  -- * Preprocessing command-line arguments
+  OptDescr(..),ArgDescr(..),usageInfo,
+  tokenize,
+  
+  -- * Example usage
+  -- $tutorial
+ ) where
+
+import Control.Parser
+import System.Console.GetOpt
+
+-- |Create a Parser that preprocesses the command-line arguments,
+-- splitting options and their arguments into a user-defined data
+-- type.
+tokenize :: [OptDescr a] -> (String -> a) -> Parser String [String] [a]
+tokenize options wrap = p^.parser
+  where p a = (concat err,pure (a,bs))
+          where (bs,_,err) = getOpt (ReturnInOrder wrap) options a
+
+{- $tutorial
+
+This module is intended to provide simple parsing functionality to the
+handling of command-line arguments. Here is an example of how this module
+may be used.
+
+
+>data Option = Help | Version | Other String
+>           deriving Eq
+>  
+>options = [
+>  Option ['h'] ["help"] (NoArg Help) "Display this menu.",
+>  Option ['v'] ["version"] (NoArg Version) "Show the version of this program"
+>  ]
+>
+>mainAxiom = single Help >> lift (putStrLn (usageInfo options))
+>          <+> single Version >> lift (putStrLn "Version: 1.0")
+>
+>main = void $ do
+>    getArgs >>= (mainAxiom <*< tokenize options Other)
+
+-}
+
+
diff --git a/src/Control/Parser/HTTP.hs b/src/Control/Parser/HTTP.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Parser/HTTP.hs
@@ -0,0 +1,62 @@
+module Control.Parser.HTTP (
+  module Control.Parser,
+
+  URI(..),uriId,uri,
+
+  Request(..),ReqType(..),Response(..),Status(..),Header(..),Host,
+  reqLine,request
+  ) where
+
+import Control.Parser hiding (space,spaces)
+import Data.Char
+import Data.List (intercalate)
+
+data URI = URI {
+  uriScheme :: String,
+  uriUser :: Maybe String,
+  uriHost :: String,
+  uriPort :: Maybe Int,
+  uriPath :: [String],
+  uriRequest :: Maybe String,
+  uriFragment :: Maybe String
+  }
+         deriving Show
+
+uriId :: (Monoid w,Stream Char s,Monad m) => ParserT w s m String
+uriId = many1 (satisfy (\c -> isAlphaNum c || c`elem`['-','_','~','.']))
+
+uri :: (Monoid w,Stream Char s,Monad m) => ParserT w s m URI
+uri = URI<$>(uriId <* several "://")
+      <*>tryMay (uriId <* single '@')
+      <*>uriId
+      <*>tryMay (single ':' *> number)
+      <*>many ("/"<$single '/' <+> uriId)
+      <*>tryMay (single '?' >> many (noneOf "#"))
+      <*>tryMay (single '#' >> many token)
+
+
+data Request = Request ReqType [Header] Host FilePath
+data ReqType = GET | HEAD | POST ByteString
+data Response = Response Status [Header] ByteString
+data Status = OK | NotFound
+data Header = Header String String
+type Host = String
+
+space :: (Monoid w, Monad m, Stream Char s) => ParserT w s m Char
+space = sp <+> (nl >> sp)
+  where sp = oneOf " \t"
+spaces :: (Monoid w, Monad m, Stream Char s) => ParserT w s m String
+spaces = many space
+nl :: (Monoid w, Monad m, Stream Char s) => ParserT w s m ()
+nl = try (single '\n') (several "\r\n")
+word :: (Monoid w, Monad m, Stream Char s) => ParserT w s m String
+word = quotedString '"' <+> many (noneOf " \t\n")
+line :: (Monoid w, Monad m, Stream Char s) => ParserT w s m String
+line = intercalate " " <$> (spaces >> (word`sepBy`spaces)) <* (spaces >> nl)
+
+reqLine :: (Monoid w, Monad m) => ParserT w String m [String]
+reqLine = pureParser (pure<$>words)
+request :: (Monoid w, Monad m) => ParserT w String m [String]
+request = do
+  _ <- line >*> reqLine
+  many (line <*= guard . not . null)
diff --git a/src/Control/Reactive.hs b/src/Control/Reactive.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Reactive.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE RebindableSyntax, GeneralizedNewtypeDeriving, TupleSections, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ViewPatterns #-}
+module Control.Reactive (
+  -- * Reactive Modules
+  module Control.Reactive.Time,
+  module Control.Reactive.TimeVal,
+
+  -- * Reactive Events
+  Event,_event,headE,Reactive(..),
+
+  -- ** Contructing events
+  atTimes,mkEvent,
+  withTime,times,times',
+  mapFutures,
+
+  -- ** Combining events
+  (//),(<|*>),(<*|>),
+               
+  -- ** Filtering events
+  groupE,mask,
+
+  -- ** Real-world event synchronization
+  realize,realizeRT,eventMay,event,react,react2,react3,
+  
+  -- * Future values
+  Future,_future,_time,_value,futureIO,
+  ) where
+
+import SimpleH
+import Control.Concurrent
+import Control.Reactive.TimeVal
+import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.List (group)
+import Control.Reactive.Time
+
+-- |An event (a list of time-value pairs of increasing times)
+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
+  pure a = Reactive a zero
+instance Functor (Reactive t) where 
+  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 %%~ ((minBound,a)^._future :)
+
+instance (Ord t,Show t,Show a) => Show (Event t a) where show = show . yb _event
+instance Ord t => Semigroup (Event t a) where
+  (+) = (++)^.(_event<.>_event<.>_event)
+    where (x:xt) ++ (y:yt) = a : zs
+            where (a,b,sw) = inOrder x y
+                  zs | b==maxBound = if sw then xt else yt
+                     | sw = xt ++ (y:yt)
+                     | otherwise = (x:xt) ++ yt
+          a ++ [] = a
+          [] ++ b = b
+instance Ord t => Monoid (Event t a) where
+  zero = [(maxBound,undefined)]^._mapping _future._event
+instance Ord t => Applicative (Event t) where
+  fe@(yb _event -> ff:_) <*> xe@(yb _event -> fx:_) =
+    ste & traverse (by state) & yb 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 (yb _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
+  join = _event %%~ merge . map2 (yb _event)
+    where
+      merge [] = []
+      merge [t] = t^._value
+      merge (xs:ys:t) = xi + merge ((ys&_value%~add xe) : t) & _head._time%~(tx+)
+        where add = warp2 _OrdList (+)
+              (tx,(xi,xe)) = xs^.._future & _2%~break (ltFut ys)
+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 <&> by _future . (_1 %~ pure))^._event
+
+{-| The \'splice\' operator. Occurs when @a@ occurs.
+
+> by t: a // b = (a,before t: b)
+-}
+(//) :: Ord t => Event t a -> Event t b -> Event t (a, Event t b)
+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 //
+
+{-|
+The \'over\' operator. Occurs only when @a@ occurs.
+
+> by t: a <|*> (bi,b) = a <*> (minBound,bi):b
+-}
+(<*|>) :: Ord t => Event t (a -> b) -> Reactive t a -> Event t b
+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
+f <|*> a = (&)<$>a<*|>f
+infixr 1 <|*>
+
+-- |Group the occurences of an event by equality. Occurs when the first occurence of a group occurs. 
+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_ (by _time<$>xs)+)):zs
+          where (xs,ys) = span ((==f^._value) . by _value) fs ; f = head fs
+                ~(z:zs) = group_ ys
+                sum_ = foldl' (+) zero
+headE :: Event t a -> a
+headE = by _value . head . yb _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 (Time t,a)
+withTime = mapFutures (_future %%~ listen)
+times :: Ord t => Event t a -> Event t (Time t)
+times = map2 fst withTime
+times' :: (Ord t,Monoid t) => Event t a -> Event t t
+times' = map2 (fold . timeVal) times
+
+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. Actions are evaluated
+-- as closely to their specified time as possible. However, they are
+-- all executed in order, even if it means delaying the next action
+-- further than its required time. For real-time realization of
+-- events, see the 'realizeRT' function
+realize :: Event Seconds (IO ()) -> IO ()
+realize l = traverse_ (sink_ . first timeVal) (withTime l)
+  where sink_ (Since t,v) = waitTill t >> v
+        sink_ (Always,v) = v
+        sink_ (Never,_) = unit
+-- |Sinks a frame event into the real-world, skipping frames if they come
+-- too late, thus always performing the frame closest to the current time.
+realizeRT :: Event Seconds (IO ()) -> IO ()
+realizeRT l = traverse_ (sink_ . first timeVal) (withTime l)
+  where sink_ (Since t,v) = currentTime >>= \c -> when (c<=t) (waitTill t >> v)
+        sink_ (Always,v) = v
+        sink_ (Never,_) = unit
+eventMay :: IO (Maybe a) -> IO (Event Seconds a)
+eventMay m = by _event <$> do
+  c <- newChan
+  sem <- newEmptyMVar
+  _ <- forkIO $ do
+    while $ do
+      a <- newEmptyMVar
+      writeChan c a
+      foldMap (const True)<$>(m <*= maybe unit (putMVar a))
+    putMVar sem ()
+  let event' ~(a:as) = unsafeInterleaveIO $ do
+        (:)<$>futureIO (takeMVar a)<*>event' as
+  (event' =<< getChanContents c) <*= \e -> do
+    t <- forkIO $ traverse_ (yb _thunk . timeVal . by _time) e
+    forkIO (takeMVar sem <* killThread t)
+event :: IO a -> IO (Event Seconds a)
+event = eventMay . map Just
+react :: IO a -> (Event Seconds a -> IO (Event Seconds (IO ()))) -> IO ()
+react a f = realize =<< join (f<$>event a)
+react2 :: IO a -> IO b -> (Event Seconds a -> Event Seconds b -> IO (Event Seconds (IO ()))) -> IO ()
+react2 a b f = realize =<< join (f<$>event a<*>event b)
+react3 :: IO a -> IO b -> IO c -> (Event Seconds a -> Event Seconds b -> Event Seconds c -> IO (Event Seconds (IO ()))) -> IO ()
+react3 a b c f = realize =<< join (f<$>event a<*>event b<*>event c)
+
+-- |A Future value (a value with a timestamp)
+newtype Future t a = Future (Time t,a)
+                   deriving (Show,Functor,Unit,Applicative,Traversable,Foldable,Monad,Semigroup,Monoid)
+instance Ord t => Eq (Future t a) where f == f' = compare f f'==EQ
+instance Ord t => Ord (Future t a) where compare = cmpFut
+instance Ord t => Bounded (Future t a) where
+  minBound = (minBound,undefined)^._future
+  maxBound = (maxBound,undefined)^._future
+instance Ord t => Orderable (Future t a) where
+  inOrder (Future (t,a)) (Future (t',b)) = (Future (tx,x),Future (ty,y),z)
+    where (tx,ty,z) = inOrder t t'
+          ~(x,y) = if z then (a,b) else (b,a)
+_future :: Iso (Future t a) (Future t' b) (Time t,a) (Time t',b)
+_future = iso Future (\(Future ~(t,a)) -> (t,a))
+_time :: Lens (Time t) (Time t') (Future t a) (Future t' a)
+_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 
+  time <- timeIO (readMVar val)
+  return (Future (time,readMVar val^._thunk))
+
+
diff --git a/src/Control/Reactive/Time.hs b/src/Control/Reactive/Time.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Reactive/Time.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE TupleSections, RecursiveDo, Rank2Types, DeriveDataTypeable, ImplicitParams #-}
+module Control.Reactive.Time (
+  -- * Unambiguous times
+  Time,
+  timeVal,
+
+  -- * Time utilities
+  Seconds,
+  timeIO,waitTill,currentTime,timeOrigin
+  ) where
+
+import SimpleH
+import Control.Concurrent
+import Control.Reactive.TimeVal
+import System.IO.Unsafe
+import Data.IORef
+import System.Clock
+import Control.Exception (handle,Exception(..))
+import Data.Typeable
+
+data Freezed = Freezed
+             deriving (Typeable,Show)
+instance Exception Freezed  
+
+-- |A type wrappers for timestamps that can be compared unambiguously
+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 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 fa fb) + ~(Time fa' fb') = Time (mapTL mini fa fa') (mapTL maxi fb fb')
+    where mini h x x' = if h < x then x else max x x'
+          maxi h x x' = if h > x then max x x' else x
+-- |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 fa fb) * ~(Time fa' fb') = Time (mapTL mini fa fa') (mapTL maxi fb fb')
+    where mini h x x' = if h < x then min x x' else x
+          maxi h x x' = if h > x then x else min x x'
+instance Ord t => Orderable (Time t) where
+  inOrder a b = (a*b,if z then b else a,z)
+    where z = a<=b
+
+mapTL :: (a -> b -> b -> c) -> (a -> b) -> (a -> b) -> a -> c
+mapTL _max fa fa' h = _max h x x'`unamb`_max h x' x
+  where x = fa h ; x' = fa' h
+
+instance Bounded (Time t) where
+  minBound = Time (pure minBound) (pure minBound)
+  maxBound = Time (pure maxBound) (pure maxBound)
+instance Unit Time where
+  pure t = Time (pure (pure t)) (pure (pure t)) 
+
+amb :: IO a -> IO a -> IO a
+ma `amb` mb = do
+  res <- newEmptyMVar
+  ta <- forkIO $ handle (\Freezed -> unit) $ ma >>= putMVar res . Left
+  tb <- forkIO $ handle (\Freezed -> unit) $ mb >>= putMVar res . Right
+  
+  takeMVar res >>= \c -> case c of
+    Left a -> pure a <* killThread tb
+    Right a -> pure a <* killThread ta
+unamb :: a -> a -> a
+unamb = warp2 (from _thunk) amb
+
+type Seconds = Double
+
+-- |A Time's pure value. May not be defined immediately.
+timeVal :: Time t -> TimeVal t
+timeVal (Time fa _) = fa maxBound
+
+-- |Constructs a Time representing the time by which the argument terminates.
+--
+-- Warning: This function executes its argument, ignoring its
+-- value. Thus, it would be wise to use it on idempotent blocking
+-- actions, such as @readMVar@.
+timeIO :: IO a -> IO (Time Seconds)
+timeIO io = do
+  sem <- newEmptyMVar
+  ret <- newIORef id
+  
+  minAction <- newIORef $ \tm -> readIORef ret <**> amb (readMVar sem) (
+    Since<$>case tm of
+       Always -> currentTime
+       Since t -> waitTill t >> currentTime
+       Never -> throw (toException Freezed))
+  maxAction <- newIORef $ \tm -> readIORef ret <**> amb (readMVar sem) (
+    case tm of
+      Always -> throw (toException Freezed)
+      Since t -> waitTill t >> pure Never
+      Never -> Since<$>currentTime)
+    
+  let refAction ref = \t -> unsafePerformIO (join (readIORef ref<*>pure t))
+  _ <- forkIO $ void $ mfix $ \t -> do 
+    t' <- catch (\_ -> return Never) (io >> return (pure t))
+    writeIORef minAction (const (pure t'))
+    writeIORef maxAction (const (pure t'))
+    writeIORef ret (const t')
+    putMVar sem t'
+    currentTime
+    
+  return $ Time (refAction minAction) (refAction maxAction)
+  
+waitTill :: Seconds -> IO ()
+waitTill t = do
+  now <- t `seq` currentTime
+  when (t>now) $ threadDelay (floor $ (t-now)*1000000)
+
+seconds :: TimeSpec -> Seconds
+seconds t = fromIntegral (sec t) + fromIntegral (nsec t)/1000000000 :: Seconds
+currentTime :: IO Seconds
+currentTime = seconds<$>getTime Realtime
+timeOrigin :: (( ?birthTime :: Seconds ) => IO a) -> IO a
+timeOrigin m = currentTime >>= \t -> let ?birthTime = t in m
+
diff --git a/src/Control/Reactive/TimeVal.hs b/src/Control/Reactive/TimeVal.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Reactive/TimeVal.hs
@@ -0,0 +1,30 @@
+module Control.Reactive.TimeVal (
+  TimeVal(..)
+  ) where
+
+import SimpleH
+
+-- |A type wrapper that adds a Bounded instance for types that don't possess one.
+data TimeVal t = Always | Since t | Never
+                 deriving (Show,Eq,Ord)
+instance Functor TimeVal where
+  map f (Since a) = Since (f a)
+  map _ Always = Always
+  map _ Never = Never
+instance Unit TimeVal where pure = Since
+instance Applicative TimeVal
+instance Monad TimeVal where
+  join (Since b) = b
+  join Always = Always
+  join Never = Never
+instance Foldable TimeVal where
+  fold (Since t) = t
+  fold _ = zero
+instance Traversable TimeVal where
+  sequence (Since t) = Since<$>t
+  sequence Always = pure Always
+  sequence Never = pure Never
+
+instance Bounded (TimeVal t) where
+  minBound = Always ; maxBound = Never
+
diff --git a/src/Data/Containers.hs b/src/Data/Containers.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Containers.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Data.Containers(
+  DataMap(..),
+  Set,Map,ascList,
+
+  member,delete,touch,insert,singleton,fromList
+  )
+  where
+
+import SimpleH
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.Set (Set)
+
+class Monoid m => DataMap m k a | m -> k a where
+  at :: k -> Lens' m (Maybe a)
+class Indexed f i | f -> i where
+  withKeys :: f a -> f (i,a)
+member :: DataMap m k a => k -> m -> Bool
+member k = by (at k) >>> yb _maybe
+delete :: DataMap m k a => k -> m -> m
+delete k = at k %- Nothing
+insert :: DataMap m k a => k -> a -> m -> m
+insert k a = at k %- Just a
+touch :: (Monoid a, DataMap m k a) => k -> m -> m
+touch k = insert k zero
+singleton :: DataMap m k a => k -> a -> m
+singleton = map2 ($zero) insert
+fromList :: DataMap m k a => [(k,a)] -> m
+fromList l = compose (uncurry insert<$>l) zero
+
+instance Ord a => DataMap (Set a) a Void where
+  at k = lens (S.member k) (flip (bool (S.insert k) (S.delete k)))._maybe
+instance Ord k => DataMap (Map k a) k a where
+  at k = lens (M.lookup k) (\m a -> M.alter (const a) k m)
+  
+instance Ord a => Semigroup (Set a) where (+) = S.union
+instance Ord a => Monoid (Set a) where zero = S.empty
+instance (Ord a,Monoid a) => Ring (Set a) where
+  one = singleton zero zero
+  (*) = S.intersection
+instance Functor Set where map = S.mapMonotonic
+instance Foldable Set where fold = S.foldr (+) zero
+
+instance Ord k => Semigroup (Map k a) where (+) = M.union
+instance Ord k => Monoid (Map k a) where zero = M.empty
+instance Functor (Map k) where map = M.map
+instance Foldable (Map k) where fold = M.foldr (+) zero
+instance Eq k => Traversable (Map k) where sequence = (ascList._Compose) sequence
+instance Indexed (Map k) k where withKeys = M.mapWithKey (,)
+
+ascList :: (Eq k,Eq k') => Iso [(k,a)] [(k',a')] (Map k a) (Map k' a')
+ascList = iso M.toAscList M.fromAscList
+
+newtype Bimap a b = Bimap (Map a b,Map b a)
+                  deriving (Semigroup,Monoid)
+_inverse :: Iso (Bimap a b) (Bimap c d) (Bimap b a) (Bimap d c)
+_inverse = iso (\(Bimap (b,a)) -> Bimap (a,b)) (\(Bimap (c,d)) -> Bimap (d,c))
+
+instance (Ord a,Ord b) => DataMap (Bimap a b) a b where
+  at a = lens lookup setAt
+    where lookup (Bimap (ma,_)) = ma^.at a
+          setAt (Bimap (ma,mb)) b' = Bimap (
+            ma',mb & maybe id delete b >>> maybe id (flip insert a) b')
+            where b = ma^.at a ; ma' = ma & at a %- b'
+instance (Ord b,Ord a) => DataMap (Flip Bimap b a) b a where
+  at k = from (_inverse._Flip).at k
diff --git a/src/Data/Serialize.hs b/src/Data/Serialize.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Serialize.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.Serialize (
+  module Control.Parser,
+  Serializable(..)
+  ) where
+
+import Control.Parser
+import Data.ByteString.Lazy.Builder
+import qualified Data.ByteString as BS
+import Data.ByteString.Unsafe
+import Data.Word
+import Foreign.Ptr
+import Foreign.Storable
+import qualified Data.Monoid as M
+import System.Endian
+
+class Serializable t where
+  encode :: t -> Builder
+  serializable :: Parser String ByteString t 
+
+instance Semigroup Builder where (+) = M.mappend
+instance Monoid Builder where zero = M.mempty
+
+withByteString :: ByteString -> (Ptr a -> IO b) -> b
+withByteString b f = unsafeUseAsCString b (f . castPtr)^._thunk
+
+storable :: forall a. Storable a => Parser String ByteString a
+storable = p^.parser
+  where p s | BS.length s >= sz = (zero,pure (unsafeDrop sz s,res))
+            | otherwise = ("Input too short",zero)
+          where res = withByteString s peek :: a
+                sz = sizeOf res
+  
+instance Serializable Word8 where
+  encode = word8
+  serializable = storable
+instance Serializable Word32 where
+  encode = word32BE
+  serializable = fromBE32<$>storable
+instance Serializable Word64 where
+  encode = word64BE
+  serializable = fromBE64<$>storable
+instance (Serializable a,Serializable b) => Serializable (a:*:b) where
+  encode (a,b) = encode a+encode b
+  serializable = (,)<$>serializable<*>serializable
+instance (Serializable a,Serializable b) => Serializable (a:+:b) where
+  encode (Left a) = word8 0+encode a
+  encode (Right b) = word8 1+encode b
+  serializable = storable >>= \x -> case x :: Word8 of
+    0 -> Left<$>serializable
+    1 -> Right<$>serializable
+    _ -> tell "Invalid encoding" >> zero
diff --git a/src/SimpleH.hs b/src/SimpleH.hs
--- a/src/SimpleH.hs
+++ b/src/SimpleH.hs
@@ -1,11 +1,11 @@
-module SimpleH(
-  module SimpleH.Arrow,
-  module SimpleH.Lens,
-  module SimpleH.Traversable,
-  module SimpleH.Core
+module SimpleH (
+  module Algebra.Core,
+  module Algebra.Arrow,
+  module Algebra.Traversable,
+  module Control.Lens
   ) where
 
-import SimpleH.Arrow
-import SimpleH.Core hiding (flip)
-import SimpleH.Lens
-import SimpleH.Traversable
+import Algebra.Arrow
+import Algebra.Core hiding (flip)
+import Control.Lens
+import Algebra.Traversable
diff --git a/src/SimpleH/Applicative.hs b/src/SimpleH/Applicative.hs
deleted file mode 100644
--- a/src/SimpleH/Applicative.hs
+++ /dev/null
@@ -1,138 +0,0 @@
--- |A module describing applicative functors
-module SimpleH.Applicative(
-  module SimpleH.Functor,
-
-  Applicative(..),
-  ZipList(..),ZipTree(..),Backwards(..),
-
-  (*>),(<*),(<**>),ap,sequence_,traverse_,for_,forever,
-
-  between,
-  
-  liftA,liftA2,liftA3,liftA4,
-
-  plusA,zeroA,filter
-  ) where
-
-import SimpleH.Functor
-import SimpleH.Classes
-import SimpleH.Core
-import Data.Tree
-import SimpleH.Foldable
-
-instance Applicative (Either a)
-instance Monad (Either a) where join (Right a) = a
-                                join (Left a) = Left a
-instance Applicative ((->) a)
-instance Semigroup b => Semigroup (a -> b) where (+) = plusA
-instance Monoid b => Monoid (a -> b) where zero = zeroA
-instance Ring b => Ring (a -> b) where (*) = timesA ; one = oneA
-instance Monad ((->) a) where join f x = f x x
-instance Monoid w => Applicative ((,) w)
-instance Monoid w => Monad ((,) w) where
-  join ~(w,~(w',a)) = (w+w',a)
-instance Applicative []
-instance Monad [] where join = fold
-
-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 (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 Semigroup a => Semigroup (ZipList a) where (+) = plusA
-instance Monoid a => Monoid (ZipList a) where zero = zeroA
-
-instance Functor ZipList where
-  map f (ZipList l) = ZipList (map f l)
-instance Unit ZipList where
-  pure a = ZipList (repeat a)
-instance Applicative ZipList where
-  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
-newtype ZipTree a = ZipTree (Tree a)
-instance Functor ZipTree where
-  map f (ZipTree t) = ZipTree (map f t)
-instance Unit ZipTree where
-  pure a = ZipTree (Node a (getZipList (pure (pure a))))
-instance Applicative ZipTree where
-  ZipTree (Node f fs) <*> ZipTree (Node x xs) =
-    ZipTree (Node (f x) (getZipList ((<*>)<$>ZipList fs<*>ZipList xs)))
-deriving instance Foldable ZipTree
-
--- |A wrapper for applicative functors with actions executed in the reverse order
-newtype Backwards f a = Backwards { forwards :: 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 (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 1 <*
-infixl 2 <**>,*>
-(*>) = liftA2 (flip const)
-(<*) = liftA2 const
-f <**> x = liftA2 (&) x f
-
-sequence_ = foldr (*>) (pure ())
-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 (+)
-zeroA = pure zero
-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 ((f:.:g) a) where
-  Compose f+Compose g = Compose ((+)<$>f<*>g)
-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
deleted file mode 100644
--- a/src/SimpleH/Arrow.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE DefaultSignatures, TupleSections #-}
-module SimpleH.Arrow (
-  module SimpleH.Monad,
-  
-  Arrow(..),
-  (>>^),(^>>),
-
-  Apply(..),comapA,app,dup,
-
-  Kleisli(..),
-
-  ListA(..)
-  ) where
-
-import SimpleH.Core hiding (flip)
-import SimpleH.Classes
-import SimpleH.Monad
-import SimpleH.Foldable
-
-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
-class Arrow k => Apply k where
-  apply :: k (k a b,a) b
-instance Apply (->) where apply (f,x) = f x
-instance Monad m => Arrow (StateA m) where
-  arr f = StateA (f<$>get)
-
-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)
-
-newtype ListA k a b = ListA { runListA :: k [a] [b] }
-instance Category k => Category (ListA k) where
-  id = ListA id
-  ListA a . ListA b = ListA (a . b)
-instance Arrow k => Choice (ListA k) where
-  ListA f <|> ListA g = ListA (arr partitionEithers >>> (f<#>g) >>> arr (uncurry (+)))
-instance Arrow k => Split (ListA k) where
-  ListA f <#> ListA g = ListA (arr (\l -> (fst<$>l,snd<$>l)) >>> (f<#>g)
-                               >>> 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
deleted file mode 100644
--- a/src/SimpleH/Classes.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE DefaultSignatures #-}
-module SimpleH.Classes where
-
-import SimpleH.Core
-
-class Functor f where
-  map :: (a -> b) -> f a -> f b
-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
-  fs <*> xs = fs >>= \f -> map f xs
-class Applicative m => Monad m where
-  join :: m (m a) -> m a
-  join m = m >>= id
-  infixl 1 >>=
-  (>>=) :: m a -> (a -> m b) -> m b
-  ma >>= k = join (map k ma)
-
-
diff --git a/src/SimpleH/Containers.hs b/src/SimpleH/Containers.hs
deleted file mode 100644
--- a/src/SimpleH/Containers.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-module SimpleH.Containers(
-  DataMap(..),
-
-  AList(..),
-  
-  S.Set,M.Map,
-
-  member,delete,minsert,insert
-  )
-  where
-
-import SimpleH.Core
-import SimpleH.Functor
-import SimpleH.Lens
-import qualified Data.Set as S
-import qualified Data.Map as M
-
-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 :: 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
-  alter f a s | bef && not aft = S.delete a s
-              | aft && not bef = S.insert a s
-              | otherwise = s
-    where bef = S.member a s ; aft = (_maybe %~ f) bef 
-instance Ord k => DataMap (M.Map k a) k a where
-  lookup = M.lookup ; alter = M.alter
-  
-instance Ord a => Semigroup (S.Set a) where (+) = S.union
-instance Ord a => Monoid (S.Set a) where zero = S.empty
-instance Ord k => Semigroup (M.Map k a) where (+) = M.union
-instance Ord k => Monoid (M.Map k a) where zero = M.empty
-instance Functor (M.Map k) where map = M.map
-
-newtype AList k a = AList { getAList :: [(k,a)] }
-
-newtype Bimap a b = Bimap (M.Map a b,M.Map b a)
-                  deriving (Semigroup,Monoid)
-_inverse :: Iso' (Bimap a b) (Bimap b a)
-_inverse = iso (\(Bimap (a,b)) -> Bimap (b,a)) (\(Bimap (a,b)) -> Bimap (b,a))
-
-instance (Ord a,Ord b) => DataMap (Bimap a b) a b where
-  lookup a (Bimap (ma,_)) = lookup a ma
-  alter f a (Bimap (ma,mb)) = Bimap (ma',
-                                     (maybe id delete b
-                                      >>> maybe id (insert a) b') mb)
-                                                  
-    where b = lookup a ma ; b' = lookup a ma'
-          ma' = alter f a ma
-instance (Ord b,Ord a) => DataMap (Flip Bimap b a) b a where
-  lookup b (Flip (Bimap (_,mb))) = lookup b mb
-  alter f b = from (_inverse._Flip) %~ alter f b
diff --git a/src/SimpleH/Core.hs b/src/SimpleH/Core.hs
deleted file mode 100644
--- a/src/SimpleH/Core.hs
+++ /dev/null
@@ -1,285 +0,0 @@
-{-# LANGUAGE NoRebindableSyntax, MultiParamTypeClasses, DefaultSignatures, TupleSections, EmptyDataDecls #-}
-module SimpleH.Core(
-  -- * Basic union and product types
-  Void,(:*:),(:+:),
-  
-  -- * Basic group and ring structure
-  -- ** Classes
-  Semigroup(..),Monoid(..),Ring(..),
-  SubSemi(..),
-  Unit(..),
-
-  -- ** Common monoids
-
-  -- *** 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
-  const,(&),fix,
-
-  first,second,
-
-  ifThenElse,bool,guard,fail,unit,when,unless,
-
-  tailSafe,headDef,
-
-  -- ** To use with 'OrdList'
-  Orderable(..),
-  comparing,insertOrd,invertOrd,
-  
-  -- * The rest is imported from the Prelude
-  module Prelude
-  ) where
-
-import Prelude hiding (
-  Functor(..),Monad(..),
-  sequence,mapM,mapM_,sequence_,(=<<),
-
-  map,(++),foldl,foldr,foldr1,concat,filter,length,sum,lookup,
-  (+),(*),(.),id,const,
-
-  or,any,and,all,elem
-
-  ,until)
-import qualified Prelude as P
-import Data.Tree
-import Data.Ord(comparing)
-
-data Void
-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.+)
-infixl 6 +
-instance Semigroup Void where _+_ = undefined
-instance Semigroup () where _+_ = ()
-instance Semigroup Bool where (+) = (||)
-instance Semigroup Int
-instance Semigroup Float
-instance Semigroup Double
-instance Semigroup Integer
-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 (Semigroup a,Semigroup b,Semigroup c) => Semigroup (a,b,c) where
-  ~(a,b,c) + ~(a',b',c') = (a+a',b+b',c+c')
-instance SubSemi b a => Semigroup (a:+:b) where
-  Left a+Left b = Left (a+b)
-  a+b = Right (from a+from b)
-    where from = cast <|> id
-instance Semigroup (Maybe a) where
-  Nothing + b = b ; a + _ = a
-
--- |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 Void where zero = undefined
-instance Monoid () where zero = ()
-instance Monoid Int ; instance Monoid Integer
-instance Monoid Float ; instance Monoid Double
-instance Monoid [a] where zero = []
-instance (Monoid a,Monoid b) => Monoid (a:*:b) where zero = (zero,zero)
-instance (Monoid a,Monoid b,Monoid c) => Monoid (a,b,c) where
-  zero = (zero,zero,zero)
-instance (SubSemi b a,Monoid a) => Monoid (a:+:b) where zero = Left zero
-instance Monoid Bool where zero = False
-instance Monoid (Maybe a) where zero = Nothing
-
-class (Semigroup a,Semigroup b) => SubSemi a b where
-  cast :: b -> a
-instance Monoid a => SubSemi a () where cast _ = zero
-instance Monoid a => SubSemi a Void where cast _ = 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.*)
-
-infixl 7 *
-instance Ring Bool where one = True ; (*) = (&&)
-instance Ring Int
-instance Ring Integer
-instance Ring Float
-instance Ring Double
-instance Monoid a => Ring [a] where
-  one = zero:one
-  (a:as) * (b:bs) = a+b:as*bs
-  _ * _ = zero
-instance (Ring a,Ring b) => Ring (a:*:b) where
-  one = (one,one) ; ~(a,b) * ~(c,d) = (a*c,b*d)
-
-class Unit f where
-  pure :: a -> f a
-instance Unit (Either a) where pure = Right
-instance Unit Maybe where pure = Just
-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
-instance Category (->) where
-  id = P.id
-  (.) = (P..)
-(<<<) :: 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 .
-
-class Category k => Choice k where
-  (<|>) :: k a c -> k b c -> k (a:+:b) c
-infixr 1 <|>
-instance Choice (->) where
-  (f <|> _) (Left a) = f a
-  (_ <|> g) (Right b) = g b
-
-class Category k => Split k where
-  (<#>) :: k a c -> k b d -> k (a,b) (c,d)
-infixr 2 <#>
-instance Split (->) where f <#> g = \ ~(a,b) -> (f a,g b)
-
-{-| The Product monoid -}
-newtype Product a = Product { getProduct :: a }
-instance Ring a => Semigroup (Product a) where
-  Product a+Product b = Product (a*b) 
-instance Ring a => Monoid (Product a) where
-  zero = Product one
-
-{-| 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 (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
-  Accum Nothing + Accum Nothing = Accum Nothing
-  Accum a + Accum b = Accum (Just (from a+from b))
-    where from = maybe zero id
-instance Monoid a => Monoid (Accum a) where zero = Accum Nothing
-instance Unit Accum where pure = Accum . pure
-
-{-| The Max monoid, where @(+) =~ max@ -}
-newtype Max a = Max { getMax :: a }
-              deriving (Eq,Ord,Bounded,Show)
-instance Ord a => Semigroup (Max a) where Max a+Max b = Max (max a b)
-instance (Ord a,Bounded a) => Monoid (Max a) where zero = Max minBound
-instance (Ord a,Bounded a) => Ring (Max a) where
-  one = Max maxBound
-  Max a * Max b = Max (min a b)
-
-{-| 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. The semigroup instance merges two lists so that
--- the result remains in ascending order.
-newtype OrdList a = OrdList { getOrdList :: [a] }
-                  deriving (Eq,Ord,Show)
-instance Orderable a => Semigroup (OrdList a) where
-  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
-          a ++ b = a + b
-deriving instance Orderable a => Monoid (OrdList a)
-deriving instance Unit OrdList
-
-class Ord t => Orderable t where
-  inOrder :: t -> t -> (t,t,Bool)
-instance Ord t => Orderable (Max t) where
-  inOrder (Max a) (Max b) = (Max x,Max y,z)
-    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
-        ~(y:ys) = if z then x:xs else insertOrd e xs
-
-newtype Interleave a = Interleave { interleave :: [a] }
-instance Semigroup (Interleave a) where
-  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 :: (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/File.hs b/src/SimpleH/File.hs
deleted file mode 100644
--- a/src/SimpleH/File.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-module SimpleH.File (
-  -- * Exported modules
-  module System.FilePath,module SimpleH,
-
-  -- * The File interface
-  File(..),
-  getFile,showFile,
-
-  _file,_directory,
-
-  getCurrentDirectory
-  ) where
-
-import SimpleH
-import System.Directory
-import System.FilePath ((</>))
-import System.IO.Unsafe
-import qualified Data.ByteString as BS
-
-data File = File (Maybe String) (Maybe BS.ByteString)
-          | Directory [(String,File)]
-          deriving Show
-
-il :: IO a -> IO a
-il = unsafeInterleaveIO
-
-getFile :: FilePath -> IO File
-getFile path = il $ do
-  d <- doesDirectoryExist path
-  if d then do
-    files <- unsafeInterleaveIO (getDirectoryContents path)
-    return $ Directory [(name,unsafePerformIO (getFile (path</>name)))
-                       | name <- files, not (name`elem`[".",".."])]
-    else File<$>il (tryMay $ traverse (at' _thunk) =<< readFile path)
-         <*>il (tryMay $ BS.readFile path)
-
-showFile :: File -> String
-showFile = showFile' 0
-  where showFile' n (Directory fs) = "/"+foldMap (
-          \(nm,f) -> "\n"+replicate n ' '+nm+showFile' (n+2) f) fs
-        showFile' _ (File (Just c) _) = ": "+show (takeWhile (/='\n') c)
-        showFile' _ (File _ (Just _)) = ": <bin>"
-        showFile' _ _ = ": <not-readable>"
-
-_File :: ((Maybe String,Maybe BS.ByteString):+:[(String,File)]) :<->: File
-_File = iso f' f
-  where f (File x y) = Left (x,y)
-        f (Directory d) = Right d
-        f' = uncurry File <|> Directory
-_file :: Traversal' File (Maybe String,Maybe BS.ByteString)
-_file = from _File._l
-_directory :: Traversal' File [(String,File)]
-_directory = from _File._r
-
diff --git a/src/SimpleH/Foldable.hs b/src/SimpleH/Foldable.hs
deleted file mode 100644
--- a/src/SimpleH/Foldable.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE TupleSections, MultiParamTypeClasses #-}
-module SimpleH.Foldable where
-
-import SimpleH.Core
-import SimpleH.Classes
-import SimpleH.Functor
-import Data.Tree
-
-class Functor t => Foldable t where
-  fold :: Monoid m => t m -> m
-instance Foldable Id where fold = getId
-instance Foldable (Either a) where
-  fold = pure zero <|> id
-instance Foldable Maybe where
-  fold (Just w) = w ; fold Nothing = zero
-instance Foldable ((,) a) where fold = snd
-instance Foldable [] where
-  fold [] = zero
-  fold (x:t) = x+fold t
-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 (f:.:g) where
-  fold = getCompose >>> map fold >>> fold
-
-newtype Sized f a = Sized { getSized :: f a }
-instance (Foldable f,Semigroup (Sized f a),Monoid n,Num n) =>
-         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
-
-split :: (Foldable t,Monoid b,Monoid c) => t (b:+:c) -> (b,c)
-split = foldMap ((,zero)<|>(zero,))
-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
-foldr1 :: (a -> a -> a) -> [a] -> a
-foldr1 f ~(e:t) = foldr f e t
-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
-foldl1' :: (a -> a -> a) -> [a] -> a
-foldl1' f ~(e:t) = foldl' f e t
-
-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
deleted file mode 100644
--- a/src/SimpleH/Functor.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, RankNTypes, DefaultSignatures #-}
--- |A module for functors
-module SimpleH.Functor(
-  Functor(..),Cofunctor(..),Bifunctor(..),
-  
-  Id(..),Const(..),Flip(..),(:.:)(..),(:**:)(..),(:++:)(..),
-
-  (<$>),(|||),(<$),(<&>),void,left,right,
-  promap,map2,map3
-  ) where
-
-import qualified Prelude as P
-
-import SimpleH.Classes
-import SimpleH.Core
-import Data.Tree
-
-class Cofunctor f where
-  comap :: (a -> b) -> f b -> f a
-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)
-instance Bifunctor (->)
-
-class Bifunctor p where
-  dimap :: (c -> a) -> (b -> d) -> p a b -> p c d
-  default dimap :: (Functor (p a),Cofunctor (Flip p d)) => (c -> a) -> (b -> d) -> p a b -> p c d
-  dimap f g = promap f . map g
-
-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) (map2 f subs)
-
--- |The Identity Functor
-newtype Id a = Id { getId :: a }
-             deriving Show
-instance Unit Id where pure = Id
-instance Functor Id where map f (Id a) = Id (f a)
-instance Applicative Id
-instance Monad Id where join (Id a) = a
-
--- |The Constant Functor
-newtype Const a b = Const { getConst :: a }
-instance Semigroup a => Semigroup (Const a b) where Const a+Const b = Const (a+b)
-instance Functor (Const a) where map _ (Const a) = Const a
-instance Monoid a => Unit (Const a) where pure _ = Const zero
-instance Monoid a => Applicative (Const a) where
-  Const a <*> Const b = Const (a+b)
-
--- |A motherflippin' functor
-newtype Flip f a b = Flip { unFlip :: f b a }
-
--- |The Composition functor
-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 (map2 f c)
-
-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
-instance Functor Maybe where map _ Nothing = Nothing; map f (Just a) = Just (f a)
-instance Functor ((,) b) where map f ~(b,a) = (b,f a)
-instance Functor ((->) a) where map = (.)
-deriving instance Functor Interleave
-deriving instance Functor OrdList
-
-instance Functor IO where map = P.fmap
-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
-infixr 3 <$>,<$
-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 ()
-void = (()<$)
-
-map2 :: (Functor f, Functor f') => (a -> b) -> f (f' a) -> f (f' b)
-map2 = map map map
-map3 :: (Functor f, Functor f', Functor f'') => (a -> b) -> f (f' (f'' a)) -> f (f' (f'' b))
-map3 = map map map2
-
-promap :: Cofunctor (Flip f c) => (a -> b) -> f b c -> f a c
-promap f c = unFlip (comap f (Flip c))
diff --git a/src/SimpleH/Lens.hs b/src/SimpleH/Lens.hs
deleted file mode 100644
--- a/src/SimpleH/Lens.hs
+++ /dev/null
@@ -1,258 +0,0 @@
-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies, ViewPatterns, TupleSections #-}
-{-|
-A module providing simple Lens functionality.
-
-Lenses are a Haskell abstraction that allows you to access and modify
-part of a structure, compensating for and improving upon Haskell's
-horrendous record syntax and giving Haskell a first-class record system.
-
-This module defines three kinds of Lenses : Lenses that allow you to
-access part of a structure; Traversals that allow you to modify part
-of a structure; and Isos which may be reversed. Lenses of any kind can
-be composed with @(.)@, yielding a Lens of the most general kind, so
-that composing a Lens with a Traversal or Iso yields a Lens, and a
-Traversal with an Iso yields a Traversal.
--}
-module SimpleH.Lens(
-  -- * The lens types
-  Iso,Iso',(:<->:),
-  LensLike,LensLike',
-  Fold,Fold',
-  Getter,Getter',
-  Lens,Lens',
-  Traversal,Traversal',
-
-  -- * Constructing lenses
-  iso,from,lens,getter,prism,sat,simple,(.+),
-
-  -- * Extracting values
-  (^.),(^..),(^?),(^??),(%~),(%-),(%%~),(%%-),at,at',warp,set,
-  (-.),(.-),
-  
-  -- * Basic lenses
-  _1,_2,_l,_r,_Just,Compound(..),
-  _list,_head,_tail,
-
-  -- * Isomorphisms
-  Isomorphic(..),
-  adding,
-  _Id,_OrdList,_Const,_Dual,_Endo,_Flip,_maybe,_Max,_Compose,_Backwards,
-  warp2,_mapping,_mapping',_promapping,
-  IsoFunctor(..),(<.>),IsoFunctor2(..),
-  _thunk
-  ) where
-
-import SimpleH.Core
-import SimpleH.Functor
-import SimpleH.Applicative
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Exception (evaluate)
-
-type LensLike f s t a b = (s -> f t) -> (a -> f b)
-type LensLike' f a b = LensLike f b b a a
-
-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' 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 Fold s t a b = forall f. (Semigroup (f b),Applicative f) => LensLike f s t a b
-type Fold' a b = Fold 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)
-type Iso' a b = Iso b b a a
-type a :<->: b = Iso' a b
-
-data IsoT a b s t = IsoT (s -> a) (b -> t)
-instance Functor (IsoT a b s) where map f (IsoT u v) = IsoT u (map f v)
-instance Cofunctor (Flip (IsoT a b) t) where
-  comap f (Flip (IsoT u v)) = Flip (IsoT (promap f u) v)
-instance Bifunctor (IsoT a b)
-
--- |Create an 'Iso' from two inverse functions.
-iso :: (a -> s) -> (t -> b) -> Iso s t a b
-iso f g = dimap f (map g)
-isoT :: Iso s t a b -> IsoT s t a b
-isoT i = getId<$>i (IsoT id Id)
-unIsoT :: IsoT s t a b -> Iso s t a b
-unIsoT (IsoT u v) = iso u v
--- |Reverse an 'Iso'
---
--- @
--- from :: 'Iso'' a b -> 'Iso'' b a
--- @
-from :: Iso s t a b -> Iso b a t s
-from = isoT >>> (\ ~(IsoT u v) -> IsoT v u) >>> unIsoT
--- |Create a 'Lens' from a getter and setter function.
--- 
--- @
--- lens :: (a -> b) -> (a -> b -> a) -> 'Lens'' a b
--- @
-lens :: (a -> s) -> (a -> t -> b) -> Lens s t a b
-lens f g = \k a -> g a <$> k (f a) 
-
-getter :: (a -> b) -> Traversal' a b
-getter f = \k a -> a<$k (f a)
-
--- |Create a 'Traversal' from a maybe getter and setter function.
---
--- @
--- prism :: (a -> (a:+:b)) -> (a -> b -> a) -> 'Traversal'' a b
--- @
-prism :: (a -> (b:+:s)) -> (a -> t -> b) -> Traversal s t a b 
-prism f g = \k a -> (pure <|> map (g a) . k) (f a)
-
-sat :: (a -> Bool) -> Traversal' a a
-sat p = \k a -> (if p a then k else pure) a
-
-(.+) :: Fold s t a b -> Fold s t a b -> Fold s t a b
-f .+ f' = \k a -> f k a + f' k a
-infixr 8 .+
-
--- |Retrieve a value from a structure using a 'Lens' (or 'Iso')
-infixl 8 ^.,^..,^?,^??,%~,%-,%%~,%%-
-(^.) :: a -> Getter b b a a -> b
-(^.) = flip at
-(^..) :: a -> Iso a a b 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 -> Fold' a b -> f b
-x^?l = getConst $ l (Const . pure) x
-(^??) :: a -> ((b -> Const [b] b) -> a -> Const [b] a) -> [b]
-x^??l = getConst $ l (Const . pure) x
-
-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 a a b b -> a -> c
-f.-i = f.at' i
-infixr 9 -.,.-
-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)
-warp :: Traversal s t a b -> (s -> t) -> (a -> b)
-warp l = map getId . l . map Id
-set :: Traversal s t a b -> t -> (a -> b)
-set l = warp l . const 
-
-_1 :: Lens a b (a:*:c) (b:*:c)
-_1 = lens fst (flip (first . const))
-_2 :: Lens a b (c:*:a) (c:*:b)
-_2 = lens snd (flip (second . const))
-_l :: Traversal a b (a:+:c) (b:+:c)
-_l = prism ((id ||| Right) >>> swapE) (flip (left . const))
-_r :: Traversal a b (c:+:a) (c:+:b)
-_r = prism (Left ||| id) (flip (right . const))
-_Just :: Traversal a b (Maybe a) (Maybe b)
-_Just = prism (\a -> maybe (Left Nothing) Right a) (flip (<$))
-
-swapE :: (b:+:a) -> (a:+:b)
-swapE = Right<|>Left
-
-class Compound a b s t | s -> a, b s -> t where
-  _each :: Traversal a b s t
-instance Compound a b (a,a) (b,b) where
-  _each k (a,a') = (,)<$>k a<*>k a'
-instance Compound a b (a,a,a) (b,b,b) where
-  _each k (a,a',a'') = (,,)<$>k a<*>k a'<*>k a''
-instance Compound a b (a:+:a) (b:+:b) where
-  _each k = map Left . k <|> map Right . k
-_list :: [a] :<->: (():+:(a:*:[a]))
-_list = iso (\l -> case l of
-                [] -> Left ()
-                (x:t) -> Right (x,t)) (const [] <|> uncurry (:))
-
-_head :: Traversal' [a] a
-_head = _list._r._1
-_tail :: Traversal' [a] [a]
-_tail = _list._r._2
-
-_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)
-
-class Isomorphic b a t s | t -> b, t a -> s where
-  _iso :: Iso s t a b
-instance Isomorphic a b (Id a) (Id b) where
-  _iso = iso Id getId
-instance Isomorphic [a] [b] (OrdList a) (OrdList b) where
-  _iso = iso OrdList getOrdList
-instance Isomorphic a b (Const a c) (Const b c) where
-  _iso = iso Const getConst
-instance Isomorphic a b (Dual a) (Dual b) where
-  _iso = iso Dual getDual
-instance Isomorphic a b (Max a) (Max b) where
-  _iso = iso Max getMax
-instance Isomorphic (k a a) (k b b) (Endo k a) (Endo k b) where
-  _iso = iso Endo runEndo
-instance Isomorphic (f a b) (f c d) (Flip f b a) (Flip f d c) where
-  _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)) ((f:.:g) a) ((f':.:g') b) where
-  _iso = iso Compose getCompose
-instance Isomorphic a b (Void,a) (Void,b) where
-  _iso = iso (zero,) snd
-_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 f = \a a' -> at' i (at i a`f`at i a')
-
-class IsoFunctor f where
-  mapIso :: Iso s t a b -> Iso (f s) (f t) (f a) (f b)
-class IsoFunctor2 f where
-  mapIso2 :: (a:<->:c) -> (b:<->:d) -> (f a b:<->:f c d)
-
--- | An infix synonym for 'mapIso2'
-(<.>) :: IsoFunctor2 f => (a:<->:c) -> (b:<->:d) -> (f a b:<->:f c d)
-(<.>) = mapIso2
-infixr 9 <.>
-
-instance IsoFunctor ((->) a) where mapIso = _mapping
-instance IsoFunctor2 (->) where mapIso2 i j = _promapping i._mapping j
-instance IsoFunctor2 (,) where
-  mapIso2 i j = iso (at i <#> at j) (at' i <#> at' j)
-instance IsoFunctor2 Either where
-  mapIso2 i j = iso (at i ||| at j) (at' i ||| at' j)
-
-adding :: (Num n,Semigroup n) => n -> Iso' n n
-adding n = iso (+n) (subtract n)
-
-_thunk :: Iso a b (IO a) (IO b)
-_thunk = iso unsafePerformIO evaluate
diff --git a/src/SimpleH/Monad.hs b/src/SimpleH/Monad.hs
deleted file mode 100644
--- a/src/SimpleH/Monad.hs
+++ /dev/null
@@ -1,452 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, TupleSections, Rank2Types, UndecidableInstances, FunctionalDependencies #-}
-module SimpleH.Monad(
-  module SimpleH.Applicative,
-
-  -- * The basic Monad interface
-  Monad(..),MonadFix(..),MonadTrans(..),
-
-  -- * Monad utilities
-  Kleisli(..),_Kleisli,
-  (=<<),(<=<),(>=>),(>>),(<*=),return,
-  foldlM,foldrM,while,until,
-  bind2,bind3,(>>>=),(>>>>=),
-  
-  -- * Common monads
-  -- ** The RWS Monad
-  RWST(..),RWS,
-
-  -- *** The State Monad
-  MonadState(..),
-  IOLens,_ioref,_mvar,
-  StateT,State,
-  stateT,eval,exec,state,
-  (=~),(=-),gets,saving,
-  mapAccum,mapAccum_,mapAccumR,mapAccumR_,push,pop,withPrev,withNext,
-
-  -- **** The State Arrow
-  StateA(..),stateA,
-    
-  -- *** The Reader monad
-  MonadReader(..),
-  ReaderT,Reader,
-  _readerT,_reader,
-
-  -- *** The Writer monad
-  MonadWriter(..),
-  WriterT,Writer,
-  _writerT,_writer,
-  mute,intercept,
-
-  -- ** The Continuation monad
-  MonadCont(..),
-  ContT(..),Cont,
-  evalContT,
-  evalCont,
-
-  -- ** The List monad
-  MonadList(..),
-  ListT,
-  _listT,
-
-  -- ** The Error Monad
-  MonadError(..),try,tryMay,
-  EitherT,
-  _eitherT
-  ) where
-
-import SimpleH.Classes
-import SimpleH.Applicative
-import SimpleH.Core hiding (flip)
-import SimpleH.Traversable
-import SimpleH.Lens
-import qualified Control.Exception as Ex
-import qualified Control.Monad.Fix as Fix
-import Data.IORef
-import Control.Concurrent
-
-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
-class Monad m => MonadFix m where
-  mfix :: (a -> m a) -> m a
-instance MonadFix Id where mfix = cfix
-instance MonadFix ((->) b) where mfix = cfix
-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 MonadFix m => MonadFix (Backwards m) where
-  mfix f = at _Backwards $ mfix (at' _Backwards.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 = map fix . collect
-
-mfixing :: MonadFix f => (b -> f (a, b)) -> f a
-mfixing f = fst<$>mfix (\ ~(_,b) -> f b )
-
-class MonadTrans t where
-  lift :: Monad m => m a -> t m a
-class MonadTrans t => MonadInternal t where
-  internal :: Monad m => (forall c. m (c,a) -> m (c,b)) ->
-              (t m a -> t m b)
-
-newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
-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 => Split (Kleisli m) where
-  Kleisli f <#> Kleisli g = Kleisli (\(a,c) -> (,)<$>f a<*>g c)
-instance Isomorphic (a -> m b) (c -> m' d) (Kleisli m a b) (Kleisli m' c d) where
-  _iso = iso Kleisli runKleisli
-_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 =<<
-infixl 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 (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
-  pure a = RWST (\ ~(_,s) -> pure (a,s,zero))
-instance Functor f => Functor (RWST r w s f) where
-  map f (RWST fa) = RWST (fa >>> map (\ ~(a,s,w) -> (f a,s,w)))
-instance (Monoid w,Monad m) => Applicative (RWST r w s m)
-instance (Monoid w,Monad m) => Monad (RWST r w s m) where
-  join mm = RWST (\ ~(r,s) -> do
-                     ~(m,s',w) <- runRWST mm (r,s)
-                     ~(a,s'',w') <- runRWST m (r,s')
-                     return (a,s'',w+w'))
-instance (Monoid w,MonadFix m) => MonadFix (RWST r w s m) where
-  mfix f = RWST (\x -> mfix (\ ~(a,_,_) -> runRWST (f a) x))
-instance (Monoid w,MonadCont m) => MonadCont (RWST r w s m) where
-  callCC f = RWST $ \(r,s) ->
-    callCC $ \k -> runRWST (f (\a -> lift (k (a,s,zero)))) (r,s)
-deriving instance Semigroup (m (a,s,w)) => Semigroup (RWST r w s m a)
-deriving instance Monoid (m (a,s,w)) => Monoid (RWST r w s m a)
-deriving instance Ring (m (a,s,w)) => Ring (RWST r w s m a)
-instance (Monad m,Monoid w) => MonadState s (RWST r w s m) where
-  get = RWST (\ ~(_,s) -> pure (s,s,zero) )
-  put s = RWST (\ _ -> pure ((),s,zero) )
-  modify f = RWST (\ ~(_,s) -> pure ((),f s,zero) )
-instance (Monad m,Monoid w) => MonadReader r (RWST r w s m) where
-  ask = RWST (\ ~(r,s) -> pure (r,s,zero) )
-  local f (RWST m) = RWST (\ ~(r,s) -> m (f r,s) )
-instance (Monad m,Monoid w) => MonadWriter w (RWST r w s m) where
-  tell w = RWST (\ ~(_,s) -> pure ((),s,w) )
-  listen (RWST m) = RWST (m >>> map (\ ~(a,s,w) -> ((w,a),s,w) ) )
-  censor (RWST m) = RWST (m >>> map (\ ~(~(a,f),s,w) -> (a,s,f w) ) )
-instance Foldable m => Foldable (RWST Void w Void m) where
-  fold (RWST m) = foldMap (\(w,_,_) -> w).m $ (zero,zero)
-instance Traversable m => Traversable (RWST Void w Void m) where
-  sequence (RWST m) = map (RWST . const . map (\((s,w),a) -> (a,s,w)))
-                      . sequence . map (\(a,s,w) -> sequence ((s,w),a))
-                      $ m (zero,zero)
-instance (Monoid w,MonadError e m) => MonadError e (RWST r w s m) where
-  throw = lift.throw
-  catch f (RWST m) = RWST (\x -> catch (flip runRWST x.f) (m x))
-instance Monoid w => MonadTrans (RWST r w s) where
-  lift m = RWST (\ ~(_,s) -> (,s,zero) <$> m)
-instance (Monoid w) => MonadInternal (RWST r w s) where
-  internal f (RWST m) = RWST (\ x -> f (m x <&> \ ~(a,s,w) -> ((s,w),a) )
-                                     <&> \ ~((s,w),b) -> (b,s,w) )
-  
-{-| A simple State Monad  -}
-class Monad m => MonadState s m | m -> s where
-  get :: m s
-  put :: s -> m ()
-  put = modify . const
-  modify :: (s -> s) -> m ()
-  modify f = get >>= put . f
-instance MonadState (IO ()) IO where
-  get = return unit
-  put a = a
-  modify f = put (f unit)
-type IOLens a = Lens' (IO ()) (IO a)
-_ioref :: IORef a -> IOLens a
-_ioref r = lens (const (readIORef r)) (\x a -> x >> a >>= writeIORef r)
-_mvar :: MVar a -> IOLens a
-_mvar r = lens (const (readMVar r)) (\x a -> x >> a >>= putMVar r)
-
-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,
-                               MonadTrans,MonadInternal,
-                               MonadCont,MonadState s)
-type State s a = StateT s Id a
-instance MonadReader r m => MonadReader r (StateT s m) where
-  ask = ask_ ; local = local_
-instance MonadWriter w m => MonadWriter w (StateT s m) where
-  tell = tell_ ; listen = listen_ ; censor = censor_
-deriving instance MonadError e m => MonadError e (StateT s m)
-deriving instance Semigroup (m (a,s,Void)) => Semigroup (StateT s m a)
-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 (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,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 :: (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 ()
-infixl 0 =-,=~
-l =- x = modify (set l x)
-(=~) :: MonadState s m => Lens' s s' -> (s' -> s') -> m ()
-l =~ f = modify (warp l f)
-gets :: MonadState s m => Lens' s s' -> m s'
-gets l = at l<$>get
-
-saving :: MonadState s m => Lens' s s' -> m a -> m a
-saving l st = gets l >>= \s -> st <* (l =- s)
-
--- * The State Arrow
-newtype StateA m s a = StateA (StateT s m a)
-stateA :: Iso (StateA m s a) (StateA m' s' a') (StateT s m a) (StateT s' m' a')
-stateA = iso StateA (\(StateA s) -> s)
-instance Monad m => Category (StateA m) where
-  id = StateA get
-  StateA sbc . StateA sab = StateA $ (^.stateT) $ \a ->
-    (sab^..stateT) a >>= \(a',b) -> (a',).snd <$> (sbc^..stateT) b
-instance Monad m => Split (StateA m) where
-  StateA sac <#> StateA sbd = StateA $ (^.stateT)
-                              $ map2 (\((a',c),(b',d)) -> ((a',b'),(c,d)))
-                              $ (Kleisli (sac^..stateT) <#> Kleisli (sbd^..stateT)) ^.. _Kleisli
-instance Monad m => Choice (StateA m) where
-  StateA sac <|> StateA sbc = StateA $ (^.stateT) $
-                              l Left (sac^..stateT)<|>l Right (sbc^..stateT)
-    where l = map2 . first
-
-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 :: 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 | m -> r where
-  ask :: m r
-  local :: (r -> r) -> m a -> m a
-instance MonadReader r ((->) r) where
-  ask = id ; local = (>>>)
-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,
-                                MonadTrans,MonadInternal,
-                                MonadReader r,MonadCont)
-type Reader r a = ReaderT r Id 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<&>(,zero,zero) ))
-        runReaderT (ReaderT (RWST f)) r = f (r,zero) <&> \ ~(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
-  get = get_ ; put = put_ ; modify = modify_
-instance MonadWriter w m => MonadWriter w (ReaderT r m) where
-  tell = tell_ ; listen = listen_ ; censor = censor_
-deriving instance Semigroup (m (a,Void,Void)) => Semigroup (ReaderT r m a)
-deriving instance Monoid (m (a,Void,Void)) => Monoid (ReaderT r m a)
-deriving instance Ring (m (a,Void,Void)) => Ring (ReaderT r m a)
-
-class (Monad m,Monoid w) => MonadWriter w m | m -> w where
-  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,())
-  listen m@(w,_) = (w,m)
-  censor ~(w,~(a,f)) = (f w,a)
-  
-mute :: (MonadWriter w m,Monoid w) => m a -> m a
-mute m = censor (m<&>(,const zero))
-intercept :: (MonadWriter w m,Monoid w) => m a -> m (w,a)
-intercept = listen >>> mute
-
-{-| A simple Writer monad -}
-newtype WriterT w m a = WriterT (RWST Void w Void m a)
-                      deriving (Unit,Functor,Applicative,Monad,MonadFix
-                               ,Foldable,Traversable
-                               ,MonadTrans,MonadInternal
-                               ,MonadWriter w,MonadCont)
-type Writer w a = WriterT w Id a
-instance (Monoid w,MonadReader r m) => MonadReader r (WriterT w m) where
-  ask = ask_ ; local = local_
-instance (Monoid w,MonadState r m) => MonadState r (WriterT w m) where
-  get = get_ ; put = put_ ; modify = modify_
-deriving instance Semigroup (m (a,Void,w)) => Semigroup (WriterT w m a)
-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,Functor m') => Iso (WriterT w m a) (WriterT w' m' b) (m (w,a)) (m' (w',b))
-_writerT = iso writerT runWriterT
-  where writerT mw = WriterT (RWST (pure (mw <&> \ ~(w,a) -> (a,zero,w) )))
-        runWriterT (WriterT (RWST m)) = m (zero,zero) <&> \ ~(a,_,w) -> (w,a)
-_writer :: Iso (Writer w a) (Writer w' b) (w,a) (w',b)
-_writer = _Id._writerT
-
-{-| A simple continuation monad implementation  -}
-class Monad m => MonadCont m where
-  callCC :: ((a -> m b) -> m a) -> m a
-
-newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
-                      deriving (Semigroup,Monoid,Ring)
-type Cont r a = ContT r Id a
-instance Unit m => Unit (ContT r m) where pure a = ContT ($a)
-instance Functor f => Functor (ContT r f) where
-  map f (ContT c) = ContT (\kb -> c (kb . f))
-instance Applicative m => Applicative (ContT r m) where
-  ContT cf <*> ContT ca = ContT (\kb -> cf (\f -> ca (\a -> kb (f a))))
-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 >>=)
-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
-  lift = Backwards
-instance MonadFix m => Monad (Backwards m) where
-  join (Backwards ma) = Backwards$mfixing (\a -> liftA2 (,) (forwards a) ma)
-
-class Monad m => MonadList m where
-  fork :: [a] -> m a
-instance MonadList [] where fork = id
-newtype ListT m a = ListT ((m:.:[]) a)
-                    deriving (Semigroup,Monoid,
-                              Functor,Applicative,Unit,Monad,
-                              Foldable,Traversable)
-_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 
-instance MonadFix m => MonadFix (ListT m) where
-  mfix f = at _listT (mfix (at' _listT . f . head))
-instance MonadTrans ListT where
-  lift ma = (return<$>ma)^._listT
-instance MonadState s m => MonadState s (ListT m) where
-  get = get_ ; modify = modify_ ; put = put_
-instance MonadWriter w m => MonadWriter w (ListT m) where
-  tell = lift.tell
-  listen = _listT-.map sequence.listen.-_listT
-  censor = _listT-.censor.map (\l -> (fst<$>l,compose (snd<$>l))).-_listT
-instance Monad m => MonadError Void (ListT m) where
-  throw = const zero
-  catch f mm = mm & _listT %%~ (\m -> m >>= \_l -> case _l of
-                                   [] -> f zero^.._listT; l -> pure l)
-
-class Monad m => MonadError e m | m -> e where
-  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))
-tryMay :: MonadError Ex.SomeException m => m a -> m (Maybe a)
-tryMay m = catch (\(Ex.SomeException _) -> return Nothing) (Just<$>m)
-
-instance MonadError e (Either e) where
-  throw = Left
-  catch f = f<|>Right
-instance MonadError Void [] where
-  throw = const zero
-  catch f [] = f zero
-  catch _ l = l
-newtype EitherT e m a = EitherT ((m:.:Either e) a)
-                      deriving (Unit,Functor,Applicative,Monad,MonadFix
-                               ,Foldable,Traversable)
-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
-instance MonadError Void Maybe where
-  throw = const Nothing
-  catch f Nothing = f zero
-  catch _ a = a
-instance Ex.Exception e => MonadError e IO where
-  throw = Ex.throw
-  catch = flip Ex.catch
-
diff --git a/src/SimpleH/Parser.hs b/src/SimpleH/Parser.hs
deleted file mode 100644
--- a/src/SimpleH/Parser.hs
+++ /dev/null
@@ -1,148 +0,0 @@
--- |A module providing simple Parser combinator functionality. Useful
--- for small parsing tasks such as identifier parsing or command-line
--- argument parsing
-module SimpleH.Parser (
-  module SimpleH,
-  -- * The ParserT Type
-  ParserT(..),Parser,ParserA(..),_ParserA,
-  -- ** The Stream class
-  Stream(..),empty,
-  -- ** Converting to/from Parsers
-  parserT,parser,runParser,pureParser,
-  
-  -- * Basic utilities
-  (<+>),(>*>),token,satisfy,remaining,oneOf,noneOf,single,several,eoi,
-  
-  -- * Basic combinators
-  many,many1,sepBy,sepBy1,
-  chainl,chainr                          
-  ) where
-
-import SimpleH
-
-import qualified Data.ByteString as BS
-
-newtype ParserT w s m a = ParserT (StateT s (ListT (WriterT w m)) a)
-                        deriving (Unit,Functor,Applicative,Monoid,Semigroup,
-                                  Monad,MonadFix,MonadState s,MonadWriter w)
-type Parser w c a = ParserT w c Id a
-deriving instance (Monad m,Monoid w) => MonadError Void (ParserT w c m)
-instance Monoid w => MonadTrans (ParserT w s) where
-  lift = ParserT . lift . lift . lift
-
-_ParserT :: Iso (ParserT w s m a) (ParserT x t n b) (StateT s (ListT (WriterT w m)) a) (StateT t (ListT (WriterT x n)) b)
-_ParserT = iso ParserT (\(ParserT p) -> p)
-parserT :: (Functor n,Functor m) => Iso (ParserT w s m a) (ParserT x t n b) (s -> m (w,[(s,a)])) (t -> n (x,[(t,b)]))
-parserT = _mapping (_writerT._listT).stateT._ParserT
-parser :: Iso (Parser w s a) (Parser x t b) (s -> (w,[(s,a)])) (t -> (x,[(t,b)]))
-parser = _mapping _Id.parserT
-runParser :: Parser Void s a -> s -> [(s,a)]
-runParser p = snd . (p^..parser)
-pureParser :: (Monoid w,Monad m) => (a -> [b]) -> ParserT w a m b
-pureParser p = (\a -> pure (zero,[(a,b) | b <- p a]))^.parserT
-
--- |The @(+)@ operator with lower priority
-(<+>) :: Semigroup m => m -> m -> m
-(<+>) = (+)
-(>*>) :: (Monoid w, Monad m) => ParserT w a m b -> ParserT w b m c -> ParserT w a m c
-(>*>) = (>>>)^..(_ParserA<.>_ParserA<.>_ParserA)
-
-newtype ParserA w m s a = ParserA (ParserT w s m a)
-_ParserA :: Iso (ParserA w m s a) (ParserA w' m' s' a') (ParserT w s m a) (ParserT w' s' m' a')
-_ParserA = iso ParserA (\(ParserA p) -> p)
-parserA :: Iso (ParserA w m s a) (ParserA w' m' s' a') (StateA (ListT (WriterT w m)) s a) (StateA (ListT (WriterT w' m')) s' a') 
-parserA = from stateA._ParserT._ParserA
-instance (Monoid w,Monad m) => Category (ParserA w m) where
-  id = ParserA get
-  (.) = (.)^.(parserA<.>parserA<.>parserA)
-instance (Monoid w,Monad m) => Split (ParserA w m) where
-  (<#>) = (<#>)^.(parserA<.>parserA<.>parserA)
-instance (Monoid w,Monad m) => Choice (ParserA w m) where
-  (<|>) = (<|>)^.(parserA<.>parserA<.>parserA)
-instance (Monoid w,Monad m) => Arrow (ParserA w m) where
-  arr f = arr f^.parserA
-
--- |The remaining Stream to parse
-remaining :: (Monad m,Monoid w) => ParserT w s m s
-remaining = get
--- |Consume a token from the Stream
-token :: (Monad m,Monoid w,Stream c s) => ParserT w s m c
-{-# SPECIALIZE token :: (Monad m,Monoid w) => ParserT w [c] m c #-}
-token = get >>= \s -> case uncons s of
-  Nothing -> zero
-  Just (c,t) -> put t >> pure c
-
--- |Parse zero, one or more successive occurences of a parser.
-many :: (Monoid w,Monad m) => ParserT w c m a -> ParserT w c m [a]
-many p = liftA2 (:) p (many p) <+> pure []
--- |Parse one or more successiveé occurences of a parser.
-many1 :: (Monoid w,Monad m) => ParserT w c m a -> ParserT w c m [a]
-many1 p = (:)<$>p<*>many p
-
--- |Consume a token and succeed if it verifies a predicate
-satisfy :: (Monoid w, Monad m, Stream c s) => (c -> Bool) -> ParserT w s m c
-{-# SPECIALIZE satisfy :: (Monoid w, Monad m) => (c -> Bool) -> ParserT w [c] m c #-}
-satisfy p = token <*= guard . p
--- |Consume a single fixed token or fail.
-single :: (Eq c, Monoid w, Monad m, Stream c s) => c -> ParserT w s m ()
-single = void . satisfy . (==)
-
--- |Consume a structure of characters or fail
-several :: (Eq c, Monoid w, Monad m, Foldable t, Stream c s) => t c -> ParserT w s m ()
-{-# SPECIALIZE several :: (Eq c, Monoid w, Monad m) => [c] -> ParserT w [c] m () #-}
-several l = traverse_ single l
-
--- |Try to consume a parser. Return a default value when it fails.
-option :: (Monoid w,Monad m) => a -> ParserT w s m a -> ParserT w s m a
-option a p = p+pure a
-
--- |Succeed only if we are at the End Of Input.
-eoi :: (Monad m,Monoid w,Stream c s) => ParserT w s m ()
-eoi = remaining >>= guard.empty
-
--- |Parse one or more successive occurences of a parser separated by
--- occurences of a second parser.
-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)
--- |Parse zero or more successive occurences of a parser separated by
--- occurences of a second parser.
-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)
-
--- |Parse a member of a set of values
-oneOf :: (Eq c, Monoid w, Monad m, Foldable t, Stream c s) => t c -> ParserT w s m c
-oneOf = satisfy . flip elem
--- |Parse anything but a member of a set
-noneOf :: (Eq c, Monoid w, Monad m, Foldable t, Stream c s) => t c -> ParserT w s m c
-noneOf = satisfy . map not . flip elem
-
-infixl 1 `sepBy`,`sepBy1`
-infixr 0 <+>
-
--- |Chain an operator with an initial value and several tail values.
-chainr :: (Monoid w,Stream c s,Monad m) => ParserT w s m a -> ParserT w s m (b -> a -> a) -> ParserT w s m b -> ParserT w s m a
-chainr expr op e = compose<$>many (op<**>e)<*>expr
--- |Chain an operator with an initial value
-chainl :: (Monoid w,Stream c s,Monad m) => ParserT w s m a -> ParserT w s m (a -> b -> a) -> ParserT w s m b -> ParserT w s m a
-chainl expr op e = compose<$>many (flip<$>op<*>e)<**>expr
-
-
-class Stream c s | s -> c where
-  uncons :: s -> Maybe (c,s)
-  cons :: c -> s -> s
-instance Stream a [a] where
-  uncons [] = Nothing
-  uncons (x:xs) = Just (x,xs)
-  cons = (:)
-
--- |Test if a Stream is empty
-empty :: Stream c s => s -> Bool
-empty = maybe True (const False) . uncons
-
-class Serializable t where
-  encode :: t -> BS.ByteString
-  decode :: Parser String BS.ByteString t
-instance Serializable BS.ByteString where
-  encode = id
-  decode = get
-
diff --git a/src/SimpleH/Parser/CmdArgs.hs b/src/SimpleH/Parser/CmdArgs.hs
deleted file mode 100644
--- a/src/SimpleH/Parser/CmdArgs.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-module SimpleH.Parser.CmdArgs (
-  -- * Exported modules
-  module SimpleH.Parser,
-
-  -- * Preprocessing command-line arguments
-  OptDescr(..),ArgDescr(..),usageInfo,
-  tokenize,
-  
-  -- * Example usage
-  -- $tutorial
- ) where
-
-import SimpleH.Parser
-import System.Console.GetOpt
-
--- |Create a Parser that preprocesses the command-line arguments,
--- splitting options and their arguments into a user-defined data
--- type.
-tokenize :: Monad m => [OptDescr a] -> (String -> a) -> ParserT String [String] m [a]
-tokenize options wrap = p^.parserT
-  where p a = pure (concat err,pure (a,bs))
-          where (bs,_,err) = getOpt (ReturnInOrder wrap) options a
-
-{- $tutorial
-
-This module is intended to provide simple parsing functionality to the
-handling of command-line arguments. Here is an example of how this module
-may be used.
-
-
->data Option = Help | Version | Other String
->           deriving Eq
->  
->options = [
->  Option ['h'] ["help"] (NoArg Help) "Display this menu.",
->  Option ['v'] ["version"] (NoArg Version) "Show the version of this program"
->  ]
->
->(>>>>) = (>>>)^.(_ParserA<.>_ParserA<.>parserT._ParserA)
->
->doit = single Help >> lift (putStrLn (usageInfo options))
->     <+> single Version >> lift (putStrLn "Version: 1.0")
->
->main = void $ do
->    getArgs >>= (tokenize options Other >>>> doit)
-
--}
-
-
diff --git a/src/SimpleH/Reactive.hs b/src/SimpleH/Reactive.hs
deleted file mode 100644
--- a/src/SimpleH/Reactive.hs
+++ /dev/null
@@ -1,171 +0,0 @@
-{-# 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,headE,Reactive(..),
-
-  -- ** Contructing events
-  atTimes,mkEvent,
-  withTime,times,
-  mapFutures,
-
-  -- ** Combining events
-  (//),(<|*>),(<*|>),
-               
-  -- ** Filtering events
-  groupE,mask,
-
-  -- ** Real-world event synchronization
-  sink,event,
-  
-  -- * Future values
-  Future,_future,_time,_value,futureIO,
-  ) where
-
-import SimpleH
-import Control.Concurrent
-import SimpleH.Reactive.TimeVal
-import System.IO.Unsafe (unsafeInterleaveIO)
-import Data.List (group)
-import SimpleH.Reactive.Time
-
--- |An event (a list of time-value pairs of increasing times)
-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
-  pure a = Reactive a zero
-instance Functor (Reactive t) where 
-  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 %%~ ((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 -> 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) = 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
-  join = map (at' _event) >>> at' _event >>> map (sequence >>> map join)
-         >>> merge >>> at _event
-    where merge [] = []
-          merge [t] = t
-          merge ([]:t) = merge t
-          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.
-
-> at t: a // b = (a,before t: b)
--}
-(//) :: Ord t => Event t a -> Event t b -> Event t (a, Event t b)
-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 //
-
-{-|
-The \'over\' operator. Occurs only when @a@ occurs.
-
-> at t: a <|*> (bi,b) = a <*> (minBound,bi):b
--}
-(<*|>) :: Ord t => Event t (a -> b) -> Reactive t a -> Event t b
-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
-f <|*> a = (&)<$>a<*|>f
-infixr 1 <|*>
-
--- |Group the occurences of an event by equality. Occurs when the first occurence of a group occurs. 
-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) = 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 :: 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. 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)
-                   deriving (Show,Functor,Unit,Applicative,Traversable,Foldable,Monad,Semigroup,Monoid)
-instance Ord t => Eq (Future t a) where f == f' = compare f f'==EQ
-instance Ord t => Ord (Future t a) where compare = cmpFut
-instance Ord t => Orderable (Future t a) where
-  inOrder (Future (t,a)) (Future (t',b)) = (Future (tx,x),Future (ty,y),z)
-    where (tx,ty,z) = inOrder t t'
-          ~(x,y) = if z then (a,b) else (b,a)
-_future :: Iso (Future t a) (Future t' b) (Time t,a) (Time t',b)
-_future = iso Future (\(Future ~(t,a)) -> (t,a))
-_time :: Lens (Time t) (Time t') (Future t a) (Future t' a)
-_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 
-  time <- timeIO (readMVar val)
-  return (Future (time,readMVar val^._thunk))
-
-
diff --git a/src/SimpleH/Reactive/Time.hs b/src/SimpleH/Reactive/Time.hs
deleted file mode 100644
--- a/src/SimpleH/Reactive/Time.hs
+++ /dev/null
@@ -1,117 +0,0 @@
-{-# LANGUAGE TupleSections, RecursiveDo, RankNTypes, DeriveDataTypeable #-}
-module SimpleH.Reactive.Time (
-  -- * Unambiguous times
-  Time,
-  timeVal,
-
-  -- * Time utilities
-  Seconds,
-  timeIO,waitTill,currentTime
-  ) where
-
-import SimpleH
-import Control.Concurrent
-import SimpleH.Reactive.TimeVal
-import System.IO.Unsafe
-import Data.IORef
-import System.Clock
-import Control.Exception (handle,Exception(..))
-import Data.Typeable
-
-data Freezed = Freezed
-             deriving (Typeable,Show)
-instance Exception Freezed  
-
--- |A type wrappers for timestamps that can be compared unambiguously
-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 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 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 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 minBound) (pure minBound)
-  maxBound = Time (pure maxBound) (pure maxBound)
-instance Unit Time where
-  pure t = Time (pure (pure t)) (pure (pure t)) 
-
-amb :: IO a -> IO a -> IO a
-ma `amb` mb = do
-  res <- newEmptyMVar
-  ta <- forkIO $ handle (\Freezed -> unit) $ ma >>= putMVar res . Left
-  tb <- forkIO $ handle (\Freezed -> unit) $ mb >>= putMVar res . Right
-  
-  takeMVar res >>= \c -> case c of
-    Left a -> pure a <* killThread tb
-    Right a -> pure a <* killThread ta
-unamb :: a -> a -> a
-unamb = warp2 (from _thunk) amb
-
-type Seconds = Double
-
--- |A Time's pure value. May not be defined immediately.
-timeVal :: Time t -> TimeVal t
-timeVal (Time fa _) = fa maxBound
-
--- |Constructs a Time representing the time at which the argument terminates.
---
--- Warning: This function executes its argument, ignoring its
--- value. Thus, it would be wise to use it on repeatable blocking
--- actions, such as @readMVar@.
-timeIO :: IO a -> IO (Time Seconds)
-timeIO io = do
-  sem <- newEmptyMVar
-  ret <- newIORef id
-  
-  minAction <- newIORef $ \tm -> readIORef ret <**> Since<$>amb (readMVar sem) (
-    case tm of
-       Always -> currentTime
-       Since t -> waitTill t >> currentTime
-       Never -> throw Freezed)
-  maxAction <- newIORef $ \tm -> readIORef ret <**> amb (Since<$>readMVar sem) (
-    case tm of
-      Always -> throw Freezed
-      Since t -> waitTill t >> pure Never
-      Never -> Since<$>currentTime)
-    
-  let refAction ref = \t -> unsafePerformIO (join (readIORef ref<*>pure t))
-  _ <- forkIO $ void $ mfix $ \t -> do 
-    _ <- io 
-    writeIORef minAction (const (pure (pure t)))
-    writeIORef maxAction (const (pure (pure t)))
-    writeIORef ret (const (pure t))
-    putMVar sem t
-    currentTime
-    
-  return $ Time (refAction minAction) (refAction maxAction)
-  
-waitTill :: Seconds -> IO ()
-waitTill t = do
-  now <- t `seq` currentTime
-  when (t>now) $ threadDelay (floor $ (t-now)*1000000)
-
-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/Reactive/TimeVal.hs b/src/SimpleH/Reactive/TimeVal.hs
deleted file mode 100644
--- a/src/SimpleH/Reactive/TimeVal.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-module SimpleH.Reactive.TimeVal (
-  TimeVal(..)
-  ) where
-
-import SimpleH
-
--- |A type wrapper that adds a Bounded instance for types that don't possess one.
-data TimeVal t = Always | Since t | Never
-                 deriving (Show,Eq,Ord)
-instance Functor TimeVal where
-  map f (Since a) = Since (f a)
-  map _ Always = Always
-  map _ Never = Never
-instance Unit TimeVal where pure = Since
-instance Applicative TimeVal
-instance Monad TimeVal where
-  join (Since b) = b
-  join Always = Always
-  join Never = Never
-instance Foldable TimeVal where
-  fold (Since t) = t
-  fold _ = zero
-instance Traversable TimeVal where
-  sequence (Since t) = Since<$>t
-  sequence Always = pure Always
-  sequence Never = pure Never
-
-instance Bounded (TimeVal t) where
-  minBound = Always ; maxBound = Never
-
diff --git a/src/SimpleH/Traversable.hs b/src/SimpleH/Traversable.hs
deleted file mode 100644
--- a/src/SimpleH/Traversable.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-module SimpleH.Traversable(
-  module SimpleH.Applicative, module SimpleH.Foldable,
-
-  Traversable(..),Contravariant(..),
-
-  traverse,foreach,transpose,flip
-  ) where
-
-import SimpleH.Classes
-import SimpleH.Core hiding (flip,(&))
-import SimpleH.Applicative
-import SimpleH.Foldable
-import SimpleH.Lens
-import Data.Tree
-
-class Foldable t => Traversable t where
-  sequence :: Applicative f => t (f a) -> f (t a)
-instance Traversable ((,) c) where
-  sequence ~(c,m) = (,) c<$>m
-instance Traversable (Either a) where
-  sequence = pure . Left <|> map Right
-instance Traversable [] where
-  sequence (x:xs) = (:)<$>x<*>sequence xs
-  sequence [] = pure []
-deriving instance Traversable Interleave
-deriving instance Traversable OrdList
-deriving instance Traversable ZipList
-instance Traversable Tree where
-  sequence (Node a subs) = Node<$>a<*>sequence (map sequence subs)
-deriving instance Traversable ZipTree
-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
-  _each = traverse
diff --git a/src/System/Simple.hs b/src/System/Simple.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Simple.hs
@@ -0,0 +1,9 @@
+module System.Simple (
+  module System.Simple.File,
+  module System.Simple.Network,
+  module System.IO
+  ) where
+
+import System.Simple.File
+import System.Simple.Network
+import System.IO (Handle)
diff --git a/src/System/Simple/File.hs b/src/System/Simple/File.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Simple/File.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE RankNTypes, ImplicitParams #-}
+module System.Simple.File (
+  -- * Exported modules
+  module System.FilePath,module SimpleH,
+
+  -- * The File interface
+  File(..),DirEntry(..),
+  getFile,
+  
+  workingDirectory,
+  Location(..),
+  pathTo,
+
+  -- ** Status
+  modTime,
+  
+  -- ** Useful Lenses
+  file,contents,child,descendant,
+  named,withExtension,
+  fileName,entry,text,fileData,
+  ) where
+
+import SimpleH
+import Data.Containers
+import Control.Reactive.Time
+import System.Directory 
+import System.FilePath ((</>),FilePath)
+import System.IO.Unsafe
+import System.Posix.Process (getProcessID)
+import Data.Time.Clock.POSIX
+import qualified Data.ByteString as BS
+import qualified Prelude as P
+
+data File = File (Maybe String) (Maybe BS.ByteString)
+          | Directory (Map String File) 
+instance Show File where
+  show (File _ _) = "File"
+  show (Directory d) = show d
+instance Semigroup File where
+  Directory d + Directory d' = Directory (d+d')
+  a + _ = a
+
+data DirEntry = DirEntry FilePath File
+              deriving Show
+instance Lens1 String String DirEntry DirEntry where
+  _1 = from _DirEntry._1
+instance Lens2 File File DirEntry DirEntry where
+  _2 = from _DirEntry._2
+fileName :: Lens' DirEntry String
+fileName = _1
+entry :: Lens' DirEntry File
+entry = _2
+
+il :: IO a -> IO a
+il = unsafeInterleaveIO
+getFile :: FilePath -> IO File
+getFile path = do
+  d <- doesDirectoryExist path
+  if d then do
+    files <- unsafeInterleaveIO (getDirectoryContents path)
+    return $ Directory $ fromList [
+      (name,unsafePerformIO (getFile (path</>name)))
+      | name <- files, not (name`elem`[".",".."])]
+    else File<$>il (tryMay $ traverse (yb _thunk) =<< P.readFile path)
+         <*>il (tryMay $ BS.readFile path)
+
+_File :: ((Maybe String,Maybe BS.ByteString):+:Map String File) :<->: File
+_File = iso f' f
+  where f (File x y) = Left (x,y)
+        f (Directory d) = Right d
+        f' = uncurry File <|> Directory
+_DirEntry :: (FilePath,File) :<->: DirEntry
+_DirEntry = iso (uncurry DirEntry) (\ ~(DirEntry p f) -> (p,f))
+file :: Traversal' File (Maybe String,Maybe BS.ByteString)
+file = from _File._l
+contents :: Traversal' File (Map String File)
+contents = from _File._r
+child :: Traversal' File File
+child = contents.traverse
+descendant :: Fold' File File
+descendant = id .+ child.descendant
+text :: Traversal' File String
+text = file._1._r
+fileData :: Traversal' File ByteString
+fileData = file._2._r
+
+named :: (String -> Bool) -> Traversal' DirEntry DirEntry
+named p = sat (\(DirEntry name _) -> p name)
+withExtension :: String -> Traversal' DirEntry DirEntry
+withExtension e = named (\s -> drop (length s-(length e+1)) s==('.':e))
+
+-- |The working directory, as a DirEntry
+workingDirectory :: IO File
+workingDirectory = getFile =<< getCurrentDirectory
+
+modTime :: FilePath -> IO Seconds
+modTime p = getModificationTime p <&> realToFrac . utcTimeToPOSIXSeconds
+
+data Location = Self | Owner | System | Here
+
+pathTo :: ( ?progName :: FilePath ) => Location -> FilePath
+pathTo Self = (getTemporaryDirectory^._thunk) </> ?progName + "-" + show (getProcessID^._thunk) 
+pathTo Owner = getHomeDirectory^._thunk </> "." + ?progName
+pathTo System = "/usr/share" </> ?progName
+pathTo Here = getCurrentDirectory^._thunk
+
diff --git a/src/System/Simple/Network.hs b/src/System/Simple/Network.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Simple/Network.hs
@@ -0,0 +1,15 @@
+module System.Simple.Network (Socket,PortNumber,listenOn,accept) where
+
+import SimpleH
+import Network (Socket)
+import qualified Network as Net
+import System.IO
+import Data.Word (Word16)
+
+type PortNumber = Word16
+
+listenOn :: PortNumber -> IO Socket
+listenOn = Net.listenOn . Net.PortNumber . fromIntegral
+
+accept :: Socket -> IO Handle
+accept = map2 (\(h,_,_) -> h) Net.accept