diff --git a/Algebra.hs b/Algebra.hs
new file mode 100644
--- /dev/null
+++ b/Algebra.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE ImplicitParams #-}
+module Algebra (
+  module Algebra.Core,
+  module Algebra.Arrow,
+  module Algebra.Traversable,
+  module Algebra.Lens,
+  trace,trace2,mtrace,debug,
+
+  cli
+  ) where
+
+import Algebra.Arrow
+import Algebra.Core hiding (flip)
+import Algebra.Lens
+import Algebra.Traversable
+import System.Environment (getArgs)
+
+trace :: String -> a -> a
+trace s x = (putStrLn s^.thunk)`seq`x
+trace2 :: String -> String -> a -> a
+trace2 b a x = trace b (x`seq`trace a x)
+mtrace :: Unit f => String -> f ()
+mtrace str = trace str (pure ())
+debug :: Show a => a -> a
+debug x = trace (show x) x
+
+cli :: (( ?cliargs :: [String] ) => IO a) -> IO a
+cli main = getArgs >>= \a -> let ?cliargs = a in main
diff --git a/Algebra/Applicative.hs b/Algebra/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Applicative.hs
@@ -0,0 +1,143 @@
+-- |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
+  ) 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 Semiring b => Semiring (a -> b) where (*) = timesA
+instance Ring b => Ring (a -> b) where 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 Semiring (f a) => Semiring (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,Semiring 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 3 <*,*>
+(*>) = 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/Algebra/Arrow.hs b/Algebra/Arrow.hs
new file mode 100644
--- /dev/null
+++ b/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/Algebra/Classes.hs b/Algebra/Classes.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Classes.hs
@@ -0,0 +1,50 @@
+{-# 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 1 <*>
+  (<*>) :: 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
+class MonadTrans t => ConcreteMonad t where
+  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 (SubSemi acc w,MonadWriter w m) => MonadWriterAcc w acc m where
+  getAcc :: m acc
+
+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/Algebra/Core.hs b/Algebra/Core.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Core.hs
@@ -0,0 +1,365 @@
+{-# LANGUAGE NoRebindableSyntax, MultiParamTypeClasses, DefaultSignatures, TupleSections, EmptyDataDecls #-}
+module Algebra.Core(
+  -- * Raw data
+  Handle,
+  Bytes,readBytes,writeBytes,contentBytes,
+  Chunk,readChunk,writeChunk,contentChunk,
+  
+  -- * Basic union and product types
+  Void,(:*:),(:+:),
+  
+  -- * Basic group and ring structure
+  -- ** Classes
+  Semigroup(..),Monoid(..),Negative(..),Disjonctive(..),Semiring(..),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,fromMaybe,
+
+  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,negate)
+import qualified Prelude as P
+import Data.Tree
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString as BSS
+import GHC.IO.Handle (Handle)
+import Data.Ord (comparing)
+
+type Chunk = BSS.ByteString
+type Bytes = BSL.ByteString
+
+readBytes :: String -> IO Bytes
+readBytes = BSL.readFile
+readChunk :: String -> IO Chunk
+readChunk = BSS.readFile
+writeBytes :: String -> Bytes -> IO ()
+writeBytes = BSL.writeFile
+writeChunk :: String -> Chunk -> IO ()
+writeChunk = BSS.writeFile
+contentBytes :: Handle -> IO Bytes
+contentBytes = BSL.hGetContents
+contentChunk :: Handle -> IO Chunk
+contentChunk = BSS.hGetContents
+
+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 Bytes where (+) = BSL.append
+instance Semigroup Chunk where (+) = BSS.append
+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 Bytes where zero = BSL.empty
+instance Monoid Chunk where zero = BSS.empty
+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 => Negative m where
+  negate :: m -> m
+  default negate :: Num m => m -> m
+  negate = P.negate
+instance Negative Int ; instance Negative Integer
+instance Negative Float ; instance Negative Double
+instance Negative Bool where negate = not
+
+class Monoid m => Disjonctive m where
+  (-) :: m -> m -> m
+  default (-) :: Num m => m -> m -> m
+  (-) = (P.-)
+instance Disjonctive Int ; instance Disjonctive Integer
+instance Disjonctive Float ; instance Disjonctive Double
+instance Disjonctive Bool where a - b = not (a==b)
+instance (Disjonctive a,Disjonctive b) => Disjonctive (a:*:b) where (a,b)-(c,d) = (a-c,b-d)
+
+class Monoid m => Semiring m where
+  (*) :: m -> m -> m
+  default (*) :: Num m => m -> m -> m
+  (*) = (P.*)
+class Semiring m => Ring m where
+  one :: m
+  default one :: Num m => m
+  one = 1
+  
+infixl 7 *
+instance Semiring Bool where (*) = (&&)
+instance Ring Bool where one = True 
+instance Semiring Int ; instance Ring Int
+instance Semiring Integer ; instance Ring Integer
+instance Semiring Float ; instance Ring Float
+instance Semiring Double ; instance Ring Double
+
+instance Monoid a => Semiring [a] where
+  (a:as) * (b:bs) = a+b:as*bs
+  _ * _ = zero
+instance Monoid a => Ring [a] where
+  one = zero:one
+instance (Semiring a,Semiring b) => Semiring (a:*:b) where
+  ~(a,b) * ~(c,d) = (a*c,b*d)
+instance (Ring a,Ring b) => Ring (a:*:b) where
+  one = (one,one)
+
+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 }
+                  deriving (Eq,Ord,Show)
+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) => Semiring (Max a) where Max a * Max b = Max (min a b)
+instance (Ord a,Bounded a) => Ring (Max a) where one = Max maxBound
+
+{-| 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 Semiring m => Semiring (Dual m) where Dual a * Dual b = Dual (b*a)
+instance Ring m => Ring (Dual m) where one = Dual one
+
+-- |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)
+
+fromMaybe :: a -> Maybe a -> a
+fromMaybe a = maybe a id
+
+($^) :: (a -> b -> c) -> b -> a -> c
+($^) = flip
diff --git a/Algebra/Foldable.hs b/Algebra/Foldable.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Foldable.hs
@@ -0,0 +1,93 @@
+{-# 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
+
+instance (Foldable f,Semigroup (f a),Monoid n,Num n) => SubSemi n (f a) where
+  cast = size
+
+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 = foldl' (+) 0 (1<$c)
+length :: [a] -> Int
+length = size
+
+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
+select :: (Unit f, Monoid (f a), Foldable t) => (a -> Bool) -> t a -> f a
+select p = fst . partition p
+refuse :: (Unit f, Monoid (f a), Foldable t) => (a -> Bool) -> t a -> f a
+refuse = select . 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 (select 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
+nonempty :: Foldable f => f a -> Bool
+nonempty = not . empty
diff --git a/Algebra/Functor.hs b/Algebra/Functor.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Functor.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE MultiParamTypeClasses, RankNTypes, DefaultSignatures #-}
+-- |A module for functors
+module Algebra.Functor(
+  Functor(..),Cofunctor(..),Bifunctor(..),Commutative(..),
+  
+  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
+
+class Commutative f where
+  commute :: f a b -> f b a
+instance Commutative (,) where
+  commute (a,b) = (b,a)
+
+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 2 <$>,<$
+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/Algebra/Lens.hs b/Algebra/Lens.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Lens.hs
@@ -0,0 +1,321 @@
+{-# 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 Algebra.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,(.+),forl,forl_,
+
+  -- * Extracting values
+  (^.),(^..),(^?),has,(^??),(%~),(%-),(%%~),(%%-),by,yb,warp,set,
+  (-.),(.-),
+  
+  -- * Basic lenses
+  Lens1(..),Lens2(..),Lens3(..),Lens4(..),
+  Trav1(..),Trav2(..),
+  Compound(..),
+  _list,_head,_tail,
+  
+  -- * Isomorphisms
+  Isomorphic(..),
+
+  -- ** Miscellaneous
+  thunk,chunk,
+
+  -- ** Type wrappers
+  _Id,_OrdList,_Const,_Dual,_Endo,_Flip,_maybe,_Max,_Compose,_Backwards,
+
+  -- ** Algebraic isomorphisms
+  negated,commuted,adding,
+
+  -- ** Higher-order isomorphisms
+  warp2,mapping,mapping',promapping,
+
+  IsoFunctor(..),(<.>),IsoFunctor2(..)
+  ) where
+
+import Algebra.Core
+import Algebra.Functor
+import Algebra.Applicative
+import System.IO.Unsafe (unsafePerformIO)
+import Control.Exception (evaluate)
+import Data.ByteString.Lazy (toStrict,fromStrict)
+
+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)
+
+simple :: Traversal a b a b -> Traversal a b a b
+simple l = l
+
+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
+
+(-.) :: 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 
+
+forl :: LensLike f a b c d -> c -> (a -> f b) -> f d
+forl l c f = l f c
+forl_ :: Functor f => LensLike f a a c c -> c -> (a -> f ()) -> f ()
+forl_ l c f = void $ l (\a -> a<$f a) c
+
+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 Trav1 a b [a] [b] where
+  _l = prism f g
+    where f [] = Left []
+          f (a:_) = Right a
+          g [] _ = []
+          g _ b = [b]
+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 = _l
+_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
+chunk :: Bytes:<->:Chunk
+chunk = iso toStrict fromStrict
+
+negated :: (Negative a,Negative b) => Iso a b a b
+negated = iso negate negate
+commuted :: Commutative f => Iso (f a b) (f c d) (f b a) (f d c)
+commuted = iso commute commute
+
+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/Algebra/Monad.hs b/Algebra/Monad.hs
new file mode 100644
--- /dev/null
+++ b/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/Algebra/Monad/Base.hs b/Algebra/Monad/Base.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/Base.hs
@@ -0,0 +1,121 @@
+module Algebra.Monad.Base (
+  module Algebra.Classes,module Algebra.Applicative,module Algebra.Core,
+  module Algebra.Traversable,module Algebra.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 Algebra.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
+instance Monad m => ConcreteMonad ((:.:) m) where
+  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
+instance ConcreteMonad Backwards where
+  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) => (a -> b -> m a) -> a -> t b -> m a
+foldlM = folding (_Kleisli._Endo._Dual) . flip
+foldrM :: (Foldable t,Monad m) => (b -> a -> m a) -> t b -> a -> m a
+foldrM = flip . 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
+instance Monad m => ConcreteMonad (Compose' m) where
+  generalize = _Compose' %%~ pure . yb _Id
+
+
+
diff --git a/Algebra/Monad/Cont.hs b/Algebra/Monad/Cont.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/Cont.hs
@@ -0,0 +1,32 @@
+module Algebra.Monad.Cont (
+  -- * The MonadCont class
+  MonadCont(..),
+  
+  -- * The Continuation transformer
+  ContT(..),Cont,
+  contT, cont
+  ) 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,Semiring,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)
+
+contT :: (Monad m,Unit m') => Iso (ContT r m r) (ContT r' m' r') (m r) (m' r')
+contT = iso (\m -> ContT (m >>=)) (\c -> runContT c return)
+cont :: Iso (Cont r r) (Cont r' r') r r'
+cont = _Id.contT
+
diff --git a/Algebra/Monad/Error.hs b/Algebra/Monad/Error.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/Error.hs
@@ -0,0 +1,44 @@
+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 e 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)
+
+(!+) :: MonadError Void m => m a -> m a -> m a
+(!+) = flip try
+infixr 0 !+
+
+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/Algebra/Monad/Foldable.hs b/Algebra/Monad/Foldable.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/Foldable.hs
@@ -0,0 +1,54 @@
+{-# 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/Algebra/Monad/RWS.hs b/Algebra/Monad/RWS.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/RWS.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.RWS (
+  RWST(..),RWS,MonadInternal(..),_RWST,
+
+  -- * Default methods
+  get_,put_,modify_,local_,ask_,tell_,listen_,censor_,getAcc_
+  ) 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 Semiring (m (a,s,w)) => Semiring (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)
+instance Monoid w => ConcreteMonad (RWST r w s) where
+  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)))
+getAcc_ :: (MonadTrans t,MonadWriterAcc w acc m) => t m acc
+getAcc_ = lift getAcc
diff --git a/Algebra/Monad/Reader.hs b/Algebra/Monad/Reader.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/Reader.hs
@@ -0,0 +1,39 @@
+{-# 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_
+instance MonadWriterAcc w acc m => MonadWriterAcc w acc (ReaderT r m) where
+  getAcc = getAcc_
+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 Semiring (m (a,Void,Void)) => Semiring (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/Algebra/Monad/State.hs b/Algebra/Monad/State.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/State.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.State (
+  -- * The State Monad
+  MonadState(..),
+  StateT,State,
+  stateT,eval,exec,state,
+  (=~),(=-),(^>=),gets,getl,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_
+instance (MonadWriterAcc w acc m) => MonadWriterAcc w acc (StateT s m) where
+  getAcc = lift getAcc
+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 Semiring (m (a,s,Void)) => Semiring (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 :: (s ->  (a, b)) -> (s -> b)
+eval = map snd
+exec :: Functor f => f (a, b) -> f a
+exec = map fst
+state :: Iso (State s a) (State t b) (s -> (s,a)) (t -> (t,b))
+state = mapping _Id.stateT
+
+(=-) :: MonadState s m => Traversal' s s' -> s' -> m ()
+infixl 0 =-,=~
+l =- x = modify (set l x)
+(=~) :: MonadState s m => Traversal' s a -> (a -> a) -> m ()
+l =~ f = modify (warp l f)
+(^>=) :: MonadState s m => LensLike m a a s s -> (a -> m ()) -> m ()
+l ^>= k = get >>= \s -> forl_ l s k
+gets :: MonadState s m => (s -> a) -> m a
+gets = (get<&>) 
+getl :: MonadState s m => Getter' s a -> m a
+getl l = by l<$>get
+
+saving :: MonadState s m => Lens' s s' -> m a -> m a
+saving l st = getl 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/Algebra/Monad/Writer.hs b/Algebra/Monad/Writer.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Monad/Writer.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Algebra.Monad.Writer (
+    -- * The Writer monad
+  MonadWriter(..),
+  mute,intercept,
+
+  -- * The Writer transformer
+  WriterT,Writer,
+  writerT,writer,pureWriter,
+
+  -- * Keeping track of where we are
+  MonadWriterAcc(..),
+
+  -- ** Implementation
+  WriterAccT,WriterAcc,
+  writerAccT,writerAcc
+  ) 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 Semiring (m (a,Void,w)) => Semiring (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
+pureWriter :: Monoid w => Iso (w,a) (w',b) a b
+pureWriter = iso (zero,) snd
+
+{-| The canonical representation of a WriterAcc Monad -}
+newtype WriterAccT w acc m a = WA { runWA :: RWST () w acc m a }
+                             deriving (Functor,Unit,Monad,Applicative,MonadFix,MonadTrans)
+type WriterAcc w acc a = WriterAccT w acc Id a
+
+instance (Monad m,SubSemi acc w,Monoid w) => MonadWriter w (WriterAccT w acc m) where
+  tell w = WA (tell w >> modify (+ cast w))
+  listen = WA . listen . runWA
+  censor (WA m) = WA $ do
+    cur <- get
+    (w,a) <- listen (censor m)
+    put $ cur + cast w
+    return a
+instance (Monad m,Monoid w,SubSemi acc w) => MonadWriterAcc w acc (WriterAccT w acc m) where
+  getAcc = WA get  
+instance (MonadState s m,Monoid w,SubSemi acc w) => MonadState s (WriterAccT w acc m) where
+  get = WA (lift get)
+  put = WA . lift . put
+
+_WriterAccT :: Iso (WriterAccT w acc m a) (WriterAccT w' acc' m' a') (RWST () w acc m a) (RWST () w' acc' m' a')
+_WriterAccT = iso WA runWA
+writerAccT :: (SubSemi acc w,SubSemi acc' w',Monoid acc,Monoid acc',Functor m)
+              => Iso (WriterAccT w acc m a) (WriterAccT w' acc' m' a') (m (a,acc,w)) (m' (a',acc',w'))
+writerAccT = iso (\m (_,s) -> m <&> \(a,s',w) -> (a,s+s',w)) ($zero)._RWST._WriterAccT
+writerAcc :: (SubSemi acc w,SubSemi acc' w',Monoid acc,Monoid acc',Functor m)
+             => Iso (WriterAcc w acc a) (WriterAcc w' acc' a') (a,acc,w) (a',acc',w')
+writerAcc = _Id.writerAccT
diff --git a/Algebra/Time.hs b/Algebra/Time.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Time.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE TupleSections, RecursiveDo, Rank2Types, DeriveDataTypeable, ImplicitParams #-}
+module Algebra.Time (
+  -- * Unambiguous times
+  Time,
+  module Data.TimeVal,
+  timeVal,
+
+  -- * Time utilities
+  Seconds,
+  timeIO,waitTill,currentTime,timeOrigin,
+
+  -- * Conversion functions
+  ms,mus,ns,minutes,hours,days
+  ) where
+
+import Algebra
+import Control.Concurrent
+import Data.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 => Semiring (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 min x x' else x
+          maxi h x x' = if h > x then x else min x x'
+instance Ord t => Ring (Time t) where
+  one = maxBound
+instance Ord t => Orderable (Time t) where
+  inOrder a b = (a*b,if z then b else a,z)
+    where z = a<=b
+
+mapTL :: Bounded c => (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 -> a <$ killThread tb
+    Right a -> a <$ killThread ta
+ambBnd :: Bounded a => IO a -> IO a -> IO a
+ambBnd a b = try (return maxBound) (a`amb`b)
+unamb :: Bounded a => a -> a -> a
+unamb = warp2 (from thunk) ambBnd
+
+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
+
+ms,mus,ns,minutes,hours,days :: Seconds -> Seconds
+ms = (/1000)
+mus = (/1000000)
+ns = (/1000000000)
+minutes = (*60)
+hours = (*3600)
+days = (*(3600*24))
diff --git a/Algebra/Traversable.hs b/Algebra/Traversable.hs
new file mode 100644
--- /dev/null
+++ b/Algebra/Traversable.hs
@@ -0,0 +1,67 @@
+module Algebra.Traversable(
+  module Algebra.Applicative, module Algebra.Foldable,
+
+  Traversable(..),Contravariant(..),
+
+  traverse,foreach,transpose,flip,project,doTimes,converted,folded,
+  ) where
+
+import Algebra.Classes
+import Algebra.Core hiding (flip,(&))
+import Algebra.Applicative
+import Algebra.Foldable
+import Algebra.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
+
+converted :: (Unit f,Unit g,Foldable f,Foldable g,Monoid (f a),Monoid (g b)) => Iso (f a) (f b) (g a) (g b)
+converted = iso convert convert
+folded :: (Unit f',Foldable f,Monoid m) => Iso m m' (f m) (f' m')
+folded = iso fold pure
+
+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
+doTimes :: Applicative f => Int -> f a -> f [a]
+doTimes n m = sequence (m <$ [1..n])
+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
+-- | The Contravariant version of 'traverse'
+project :: (Contravariant c,Functor f) => (a -> c b) -> f a -> c (f b)
+project f x = collect (map f x)
+
+instance Compound a b [a] [b] where
+  _each = traverse
diff --git a/Data/Containers.hs b/Data/Containers.hs
new file mode 100644
--- /dev/null
+++ b/Data/Containers.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, ScopedTypeVariables #-}
+module Data.Containers(
+  -- * The basic data class
+  DataMap(..),Indexed(..),OrderedMap(..),
+  
+  member,delete,touch,insert,singleton,fromList,
+  _set,_map,cached,
+
+  -- * Map instances
+  -- ** Sets and maps
+  Set,Map,
+  
+  -- ** Bimaps
+  Bimap(..),toMap,keysSet,
+
+  -- ** Relations
+  Relation(..),domains,ranges,related,link
+  )
+  where
+
+import Algebra
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.Set (Set)
+import Control.Concurrent.MVar
+
+class Monoid m => DataMap m k a | m -> k a where
+  at :: k -> Lens' m (Maybe a)
+class Indexed f i | f -> i where
+  keyed :: Iso (f (i,a)) (f (i,b)) (f a) (f b) 
+class OrderedMap m k a m' k' a' | m -> k a, m' -> k' a' where
+  ascList :: Iso [(k,a)] [(k',a')] m m'
+
+_set :: Set a -> Set a
+_set = id
+_map :: Map a b -> Map a b
+_map = id
+
+member :: DataMap m k Void => k -> Lens' m Bool
+member k = at k.from _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 Eq b => OrderedMap (Set a) a Void (Set b) b Void where
+  ascList = iso S.toAscList S.fromAscList . mapping (_iso.commuted)
+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 Eq k' => OrderedMap (Map k a) k a (Map k' a') k' a' where 
+  ascList = iso M.toAscList M.fromAscList
+  
+instance Ord a => Semigroup (Set a) where (+) = S.union
+instance Ord a => Monoid (Set a) where zero = S.empty
+instance Ord a => Disjonctive (Set a) where (-) = S.difference
+instance Ord a => Semiring (Set a) where (*) = 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 Ord k => Disjonctive (Map k a) where (-) = M.difference
+instance (Ord k,Semigroup a) => Semiring (Map k a) where (*) = M.intersectionWith (+)
+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 keyed = iso (M.mapWithKey (,)) (map snd)
+
+-- |An invertible map
+newtype Bimap a b = Bimap (Map a b,Map b a)
+                  deriving (Show,Semigroup,Monoid,Disjonctive,Semiring)
+instance Commutative Bimap where
+  commute (Bimap (b,a)) = Bimap (a,b)
+
+instance (Ord a,Ord b) => DataMap (Bimap a b) a b where
+  at a = lens lookup setAt
+    where lookup ma = toMap ma^.at a
+          setAt (Bimap (ma,mb)) b' = Bimap (
+            maybe id delete (b' >>= \b'' -> mb^.at b'') ma & at a %- b',
+            mb & maybe id delete b >>> maybe id (flip insert a) b')
+            where b = ma^.at a 
+instance (Ord b,Ord a) => DataMap (Flip Bimap b a) b a where
+  at k = from (commuted._Flip).at k
+instance (Ord a,Ord b,Ord c,Ord d) => OrderedMap (Bimap a b) a b (Bimap c d) c d where
+  ascList = iso (toMap >>> \m -> m^.ascList) (\l -> Bimap (l^..ascList,l^..ascList.mapping commuted))
+toMap :: Bimap a b -> Map a b
+toMap (Bimap (a,_)) = a
+
+keysSet :: (Eq a,Eq b) => Iso (Set a) (Set b) (Map a Void) (Map b Void)
+keysSet = ascList.from ascList
+
+--- |The Relation type
+newtype Relation a b = Relation (Map a (Set b),Map b (Set a))
+                     deriving (Show,Semigroup,Monoid,Eq,Ord)
+_Relation :: Iso (Relation a b) (Relation c d) (Map a (Set b),Map b (Set a)) (Map c (Set d),Map d (Set c))
+_Relation = iso Relation (\(Relation r) -> r)
+instance Commutative Relation where
+  commute (Relation (a,b)) = Relation (b,a)
+
+-- |Define a Relation from its ranges. O(1) <-> O(1,n*ln(n)) 
+ranges :: (Ord c,Ord d) => Iso (Map a (Set b)) (Map c (Set d)) (Relation a b) (Relation c d)
+ranges = iso (\(Relation (rs,_)) -> rs) fromRanges
+  where fromRanges rs = Relation (rs,compose (rs^.keyed <&> \ (a,bs) -> compose $ bs <&> \b ->
+                                              at b%~Just . touch a . fold) zero)
+-- |Define a Relation from its domain (uses the Commutative instance)
+domains :: (Ord c,Ord d) => Iso (Map b (Set a)) (Map d (Set c)) (Relation a b) (Relation c d)
+domains = commuted.ranges
+
+instance (Ord k,Ord a) => DataMap (Relation k a) k (Set a) where
+  at a = lens (\(Relation (rs,_)) -> rs^.at a) setRan
+    where setRan (Relation (rs,ds)) (fold -> ran) = Relation (
+            rs & at a %- if empty ran then Nothing else Just ran,
+            adjust ds)
+            where oldRan = fold $ rs^.at a
+                  adjust = compose ((oldRan-ran) <&> \b -> at b.traverse.member a %- False)
+                           >>> compose ((ran-oldRan) <&> \b -> at b %~ Just . touch a . fold)
+
+may :: (Monoid (f b),Foldable f) => Iso (Maybe (f a)) (Maybe (f b)) (f a) (f b)
+may = iso (\f -> if empty f then Nothing else Just f) (maybe zero id)
+
+related :: (Ord a,Ord b) => a -> Lens' (Relation a b) (Set b)
+related a = at a.from may
+
+link :: (Ord a,Ord b) => a -> b -> Lens' (Relation a b) Bool
+link a b = related a.member b
+
+cached :: forall a b. Ord a => (a -> b) -> a -> b
+cached f = \a -> g a^.thunk
+  where g a = do
+          m <- vm `seq` takeMVar vm
+          case m^.at a of
+            Just b -> putMVar vm m >> return b
+            Nothing -> let b = f a in putMVar vm (insert a b m) >> return b
+        vm = newMVar (zero :: Map a b)^.thunk
+
diff --git a/Data/Containers/Sequence.hs b/Data/Containers/Sequence.hs
new file mode 100644
--- /dev/null
+++ b/Data/Containers/Sequence.hs
@@ -0,0 +1,64 @@
+module Data.Containers.Sequence (
+  Sequence(..),Stream(..),take,drop,
+
+  -- * Strict and lazy slices (bytestrings on arbitrary Storable types)
+  Slice,Slices,slice,slices,_Slices,breadth,
+
+  V.unsafeWith
+  ) where
+
+import Algebra hiding (splitAt,take,drop)
+import qualified Data.List as L
+import qualified Data.ByteString.Lazy as Bytes
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.Vector.Storable as V
+
+class Monoid t => Sequence t where
+  splitAt :: Int -> t -> (t,t)
+
+take :: Sequence t => Int -> t -> t
+take = map2 fst splitAt
+drop :: Sequence t => Int -> t -> t
+drop = map2 snd splitAt
+
+instance V.Storable a => Semigroup (V.Vector a) where (+) = (V.++)
+instance V.Storable a => Monoid (V.Vector a) where zero = V.empty
+  
+instance Sequence [a] where
+  splitAt = L.splitAt
+instance Sequence Bytes where
+  splitAt = Bytes.splitAt . fromIntegral
+instance V.Storable a => Sequence (V.Vector a) where
+  splitAt = V.splitAt
+
+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 Chunk where
+  uncons = Char8.uncons
+  cons = Char8.cons
+
+type Slice a = V.Vector a
+newtype Slices a = Slices [Slice a]
+                    deriving (Semigroup,Monoid)
+_Slices :: Iso (Slices a) (Slices b) [Slice a] [Slice b]
+_Slices = iso Slices (\(Slices cs) -> cs)
+instance V.Storable a => Sequence (Slices a) where
+  splitAt _ (Slices []) = zero
+  splitAt n (Slices (h:t))
+    | l>n = let (vh,vt) = splitAt n h in (Slices [vh],Slices (vt:t))
+    | l==n = (Slices [h],Slices t)
+    | otherwise = let ~(c1,c2) = splitAt (n-l) (Slices t) in (c1 & _Slices %%~ (h:),c2)
+      where l = V.length h
+slice :: (V.Storable a,V.Storable b) => Iso (Slice a) (Slice b) [a] [b]
+slice = iso (V.unfoldr uncons) (V.foldr (:) [])
+
+slices :: (V.Storable a,V.Storable b) => Iso (Slices a) (Slices b) (Slice a) (Slice b)
+slices = iso pure V.concat . _Slices
+
+breadth :: V.Storable a => Slices a -> Int
+breadth s = s^.._Slices & foldMap V.length
diff --git a/Data/Probability.hs b/Data/Probability.hs
new file mode 100644
--- /dev/null
+++ b/Data/Probability.hs
@@ -0,0 +1,20 @@
+module Data.Probability where
+
+import Algebra
+
+newtype ProbT t m a = ProbT (WriterT (Product t) (ListT m) a)
+                    deriving (Unit,Functor,Applicative,Monad
+                             ,MonadFix,MonadWriter (Product t))
+type Prob t a = ProbT t Id a
+                             
+_ProbT :: Iso (ProbT t m a) (ProbT t' m' a') (WriterT (Product t) (ListT m) a) (WriterT (Product t') (ListT m') a')
+_ProbT = iso ProbT (\(ProbT p) -> p)
+probT :: (Functor m,Functor m') => Iso (ProbT t m a) (ProbT t' m' a') (m [(Product t,a)]) (m' [(Product t',a')])
+probT = listT.writerT._ProbT
+prob :: Iso (Prob t a) (Prob t' a') [(Product t,a)] [(Product t',a')]
+prob = _Id.probT
+
+instance (Monad m,Ring t,Fractional t) => MonadList (ProbT t m) where
+  fork l = pure [(Product x,a) | a <- l]^.probT
+    where x = 1/size l
+
diff --git a/Data/Reactive.hs b/Data/Reactive.hs
new file mode 100644
--- /dev/null
+++ b/Data/Reactive.hs
@@ -0,0 +1,209 @@
+{-# LANGUAGE RebindableSyntax, GeneralizedNewtypeDeriving, TupleSections, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ViewPatterns #-}
+module Data.Reactive (
+  -- * Reactive Modules
+  module Algebra.Time,
+
+  -- * 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,realtime,realizeRT,eventMay,event,react,react2,react3,
+  
+  -- * Future values
+  Future,_future,_time,_value,futureIO,
+  ) where
+
+import Algebra
+import Control.Concurrent
+import Data.TimeVal
+import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.List (group)
+import Algebra.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 1 <*|>
+(<|*>) :: 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
+
+-- |Creates a real-time action event (an event that skips "frames" as needed) from an ordinary event.
+realtime :: Event Seconds (IO ()) -> Event Seconds (IO ())
+realtime e = (e & flip withNext (maxBound,undefined).withTime) <&> \((_,m),(t,_)) -> do
+  c <- currentTime
+  when (pure c<t) m
+        
+-- |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 = realize . realtime
+
+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 . try (pure Nothing) . 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,try (return undefined) (readMVar val)^.thunk))
+
+
diff --git a/Data/TimeVal.hs b/Data/TimeVal.hs
new file mode 100644
--- /dev/null
+++ b/Data/TimeVal.hs
@@ -0,0 +1,30 @@
+module Data.TimeVal (
+  TimeVal(..)
+  ) where
+
+import Algebra
+
+-- |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/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,69 @@
+Bill and Ted's Public License
+=============================
+
+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.
+
+PREAMBLE
+--------
+
+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”.
+
+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.
+
+TERMS AND CONDITIONS
+--------------------
+
+### 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/definitive-base.cabal b/definitive-base.cabal
new file mode 100644
--- /dev/null
+++ b/definitive-base.cabal
@@ -0,0 +1,58 @@
+name:          definitive-base
+version:       1.0
+
+synopsis:      The base modules of the Definitive framework.
+description:     The Definitive framework is an attempt at harnessing the declarative
+  nature of Haskell to provide a solid and simple base for writing 
+  real-world programs, as well as complex algorithms.
+  
+  This package contains the base modules of the framework, and provides
+  only the most basic functionality, ranging from basic algebraic
+  structures, such as monoids and rings, to functors, applicative functors,
+  monads and transformers.
+  
+  Lenses are used heavily in all the framework's abstractions, replacing
+  more traditional functions ('WriterT' and 'runWriterT' are implemented
+  in the same isomorphism 'writerT', for example). When used wisely,
+  lenses can greatly improve clarity in both code and thought, so I
+  tried to provide for them in the most ubiquitous way possible,
+  defining them as soon as possible. Isomorphisms in particular are
+  surprisingly useful in many instances, from converting between types
+  to acting on a value's representation as if it were the value itself.
+  
+  Packages using the Definitive framework should be compiled with the 
+  RebindableSyntax flag and include the Algebra module, which exports
+  the same interface as the Prelude, except for some extras.
+  
+  Here is a list of design differences between the standard Prelude
+  and the Definitive framework :
+  
+    - The '+', '-', 'negate', and '*' are now part of the Semigroup,
+      Disjonctive, Negative, Semiring classes instead of Num (default
+      instances are defined to reimplement the Prelude, making it easy
+      to adjust your code for compatibility) 
+    
+    - The mapM, traverseM, liftM, and such functions have been hidden,
+      since they only reimplement the traverse, map, and other simpler
+      functions.
+  
+    - Lenses are used whenever possible instead of more usual functions.
+      You are encouraged to read the interface for the Algebra.Lens
+      module, which contains everything you will need to be able to use
+      lenses to their full potential (except maybe a good explanation).
+  
+      
+author:        Marc Coiffier
+maintainer:    marc.coiffier@gmail.com
+license:       OtherLicense
+license-file:  LICENSE
+
+build-type:    Simple
+cabal-version: >=1.10
+
+library
+  exposed-modules: Algebra Algebra.Arrow Algebra.Core Algebra.Classes Algebra.Monad Algebra.Monad.Base Algebra.Applicative Algebra.Functor Algebra.Foldable Algebra.Traversable Algebra.Lens Algebra.Monad.RWS Algebra.Monad.State Algebra.Monad.Reader Algebra.Monad.Writer Algebra.Monad.Cont Algebra.Monad.Foldable Algebra.Monad.Error Data.Containers Algebra.Time Data.TimeVal Data.Containers.Sequence Data.Probability Data.Reactive
+  build-depends: base (== 4.6.*), containers (== 0.5.*), deepseq (== 1.3.*), array (== 0.5.*), bytestring (== 0.10.*), clock (== 0.4.*), vector (== 0.10.*), primitive (== 0.5.*)
+  default-extensions: TypeSynonymInstances NoMonomorphismRestriction StandaloneDeriving GeneralizedNewtypeDeriving TypeOperators RebindableSyntax FlexibleInstances FlexibleContexts FunctionalDependencies TupleSections MultiParamTypeClasses Rank2Types
+  ghc-options: -Wall -fno-warn-orphans -threaded
+  default-language: Haskell2010