diff --git a/Control/Arrow/Transformer/Automaton/Monad.hs b/Control/Arrow/Transformer/Automaton/Monad.hs
new file mode 100644
--- /dev/null
+++ b/Control/Arrow/Transformer/Automaton/Monad.hs
@@ -0,0 +1,150 @@
+{-#LANGUAGE Arrows, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,
+  UndecidableInstances, FunctionalDependencies, NoMonomorphismRestriction #-}
+
+module Control.Arrow.Transformer.Automaton.Monad
+    (monadToAuto, co, autoToMonad, readerArrow, swapsnd,
+     pushError,popError,rstrength,
+     ArrowAddAutomaton (..), dispatch) where
+
+import Control.Monad
+import Control.Monad.Cont
+import Control.Monad.State (MonadState (..))
+
+import Control.Arrow
+import Control.Arrow.Operations
+import qualified Control.Arrow.Transformer as AT
+import Control.Arrow.Transformer.All
+
+import Data.Maybe
+import qualified Data.Map as M
+
+unAM (ArrowMonad f) = f
+
+monadToAuto
+  :: (ArrowAddAutomaton a a', ArrowApply a') =>
+     (i -> ContT (o, a i o) (ArrowMonad a') z) -> a i o
+monadToAuto f = liftAutomaton (proc i -> 
+     unAM ((f i) `runContT` (error "automaton ended")) -<< ())
+
+
+co
+  :: (ArrowApply a', ArrowAddAutomaton a a') =>
+     o -> ContT (o, a i o) (ArrowMonad a') i
+co o = ContT (\fi -> 
+                  return (o, liftAutomaton (proc i -> unAM (fi i) -<< ())))
+
+autoToMonad
+  :: (ArrowApply a', ArrowAddAutomaton a a') =>
+     a i (Either o z)
+     -> i
+     -> ContT (o, a i o) (ArrowMonad a') z
+autoToMonad f i = do
+  x <- lift $ ArrowMonad $ (proc () -> elimAutomaton f -< i)
+  case x of
+    (Right z,_) -> return z
+    (Left o,f') -> autoToMonad f' =<< co o
+
+
+
+class ArrowAddAutomaton a a' | a -> a' where
+    elimAutomaton :: a i o -> a' i (o, a i o)
+    liftAutomaton :: a' i (o, a i o) -> a i o
+    constantAutomaton :: a' i o -> a i o
+
+instance (Arrow a) => ArrowAddAutomaton (Automaton a) a where
+    elimAutomaton (Automaton f) = f
+    liftAutomaton = Automaton
+    constantAutomaton f = Automaton (f >>> 
+                                     arr (flip (,) (constantAutomaton f)))
+
+instance (Arrow a, Arrow a', ArrowAddAutomaton a a') 
+    => ArrowAddAutomaton (StateArrow s a) (StateArrow s a') where
+   elimAutomaton = autoState . elimAutomaton . runState 
+   liftAutomaton = stateArrow . liftAutomaton . stateAuto
+   constantAutomaton = stateArrow . constantAutomaton . runState
+    
+
+instance (ArrowState s a, ArrowApply a) => (MonadState s (ArrowMonad a)) where
+    put s = ArrowMonad (proc () -> store -< s)
+    get = ArrowMonad fetch
+
+instance (Arrow a, Arrow a', ArrowAddAutomaton a a') 
+    => ArrowAddAutomaton (ReaderArrow r a) (ReaderArrow r a') where
+   elimAutomaton = (>>> (second (arr readerArrow))) . 
+                   readerArrow . elimAutomaton . runReader
+
+   liftAutomaton = readerArrow . liftAutomaton . 
+                   (>>> (second (arr runReader))) . runReader
+    
+   constantAutomaton = readerArrow . constantAutomaton . runReader
+
+instance (ArrowChoice a, ArrowChoice a', ArrowAddAutomaton a a')
+    => ArrowAddAutomaton (ErrorArrow ex a) (ErrorArrow ex a') where
+        elimAutomaton = pushError . 
+                (>>> second (arr pushError) >>> arr rstrength) 
+                . elimAutomaton . popError
+
+        liftAutomaton f = 
+            pushError $ liftAutomaton $
+            (>>> arr (revrstrength (liftAutomaton f)) 
+             >>> second (arr popError)) 
+            $ popError f
+
+        constantAutomaton = pushError . constantAutomaton . popError
+
+
+dispatch = dispatch0 M.empty
+
+dispatch0
+  :: (Ord k,
+      ArrowAddAutomaton a a',
+      ArrowApply a') =>
+     M.Map k (a i o) -> (k -> a i o) -> a (i, k) o
+dispatch0 mp def = liftAutomaton $ proc (i,k) -> do
+                    let f = fromMaybe (def k) (M.lookup k mp)
+                    (o,f') <- app -< (elimAutomaton f,i)
+                    returnA -< (o, dispatch0 (M.insert k f' mp) def)
+                    
+
+--Utility functions
+
+swapsnd :: ((a, b), c) -> ((a, c), b)
+swapsnd ~(~(x, y), z) = ((x, z), y)
+
+rstrength :: (Either ex a, b) -> Either ex (a, b)
+rstrength (Left ex, _) = Left ex
+rstrength (Right a, b) = Right (a, b)
+
+revrstrength :: b -> Either ex (a,b) -> (Either ex a, b)
+revrstrength def (Left ex) = (Left ex, def)
+revrstrength _ (Right (a,b)) = (Right a, b)
+
+autoState :: (Arrow a, Arrow a') => a' (i,s) ((o,s), a (i,s) (o,s)) -> 
+             StateArrow s a' i (o,StateArrow s a i o)
+autoState f = stateArrow $ f >>> second (arr stateArrow) >>> arr swapsnd
+
+stateAuto :: (Arrow a, Arrow a') => StateArrow s a' i (o,StateArrow s a i o) ->
+             a' (i,s) ((o,s), a (i,s) (o,s))
+stateAuto f = runState (f >>> second (arr runState)) >>> arr swapsnd
+
+
+--simulating the unexported data constructors for StateArrow,
+--ReaderArrow, ErrorArrow
+
+stateArrow :: (Arrow a) => a (t, s) (b, s) -> StateArrow s a t b
+stateArrow f = proc i -> do
+                 s <- fetch -< ()
+                 (o,s') <- AT.lift f -< (i,s)
+                 store -< s'
+                 returnA -< o
+
+readerArrow :: (Arrow a) => a (e,r) b -> ReaderArrow r a e b
+readerArrow f = proc i -> do
+                  r <- readState -< ()
+                  AT.lift f -< (i,r)
+
+popError :: (ArrowChoice a) => ErrorArrow ex a e b -> a e (Either ex b)
+popError f = runError (f >>> arr Right) (arr snd >>> arr Left)
+
+pushError :: (ArrowChoice a) => a e (Either ex b) -> ErrorArrow ex a e b
+pushError f = (AT.lift f) >>> (raise ||| arr id)
diff --git a/Control/Arrow/Transformer/LabeledArrow.hs b/Control/Arrow/Transformer/LabeledArrow.hs
new file mode 100644
--- /dev/null
+++ b/Control/Arrow/Transformer/LabeledArrow.hs
@@ -0,0 +1,126 @@
+{-#LANGUAGE Arrows, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,
+  UndecidableInstances, FunctionalDependencies, NoMonomorphismRestriction #-}
+
+module Control.Arrow.Transformer.LabeledArrow where
+
+import qualified Control.Category as C
+import Control.Monad
+import Control.Monad.Cont
+
+import Control.Arrow
+import Control.Arrow.Operations
+import qualified Control.Arrow.Transformer as AT
+import Control.Arrow.Transformer.All
+import Control.Arrow.Transformer.Automaton.Monad
+
+import Data.Maybe
+import Data.List
+import Data.List.Split (splitOn)
+import qualified Data.Map as M
+
+newtype Label = Label Integer
+
+base64 = "abcdefghijklmnopqrstuvwxyz"++
+         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"++
+         "1234567890_:"
+
+instance Show Label where
+    show (Label 0) = ""
+    show (Label n) = [(base64 !! fromIntegral mod)] ++ show (Label div)
+        where
+          (div,mod) = divMod n 64
+    
+instance Read Label where
+    readsPrec _ s = case read64 s of
+                      Just x -> [(Label x, "")]
+                      Nothing -> []
+
+read64 [] = Just 0
+read64 (c:cs) = case lookup c (zip base64 [0..]) of
+                  Just n -> fmap (\k -> n + 64*k) (read64 cs)
+                  Nothing -> Nothing
+
+alterReader q f = proc i -> do
+  s <- readState -< ()
+  newReader f -< (i,q s)
+
+pushId x = alterReader (\(Label z) -> Label (2*z + x))
+
+class (Arrow a, Arrow a') => ArrowAddLabel a a' | a -> a' where
+    runLabel :: a' (e,Label) b -> a e b
+
+instance Arrow a => ArrowAddLabel (LabeledArrow a) a where
+    runLabel = runArrowLabel
+
+instance (ArrowAddLabel a a') => 
+    ArrowAddLabel (ReaderArrow r a) (ReaderArrow r a') where
+    runLabel f = readerArrow $ runLabel (arr swapsnd >>> runReader f)
+
+instance (ArrowAddLabel a a',ArrowChoice a, ArrowChoice a') => 
+    ArrowAddLabel (ErrorArrow ex a) (ErrorArrow ex a') where
+    runLabel f = pushError $ runLabel $ popError f
+
+instance ArrowReader r a => ArrowReader r (LabeledArrow a) where
+    readState = LabeledArrow (AT.lift readState)
+    newReader (LabeledArrow f) = LabeledArrow $ readerArrow $ 
+                                 arr (swapsnd) >>> newReader (runReader f) 
+
+runArrowLabel f = LabeledArrow (proc e -> do
+                                  lab <- readState -< ()
+                                  AT.lift f -< (e,lab))
+
+newtype LabeledArrow a i o = LabeledArrow (ReaderArrow Label a i o)
+
+unLA (LabeledArrow f) = f
+
+runLabeledArrow (LabeledArrow f) = proc i -> do
+                           runReader f -< (i,Label 1)
+
+instance (C.Category a, Arrow a) => C.Category (LabeledArrow a) where
+    (.) (LabeledArrow f) (LabeledArrow g) = 
+        LabeledArrow $ (C..) (pushId 1 f)  (pushId 0 g)
+    id = LabeledArrow (C.id)
+
+instance Arrow a => Arrow (LabeledArrow a) where
+    arr = LabeledArrow . arr
+    (***) (LabeledArrow f) (LabeledArrow g) = 
+        LabeledArrow $ (pushId 0 f *** pushId 1 g)
+    first f = f *** (arr id)
+
+instance (Arrow a, Arrow a', ArrowAddAutomaton a a') =>
+    ArrowAddAutomaton (LabeledArrow a) (LabeledArrow a') where
+        liftAutomaton (LabeledArrow f) = 
+            LabeledArrow $ liftAutomaton (f >>> second (arr unLA))
+
+        elimAutomaton (LabeledArrow f) = 
+            LabeledArrow $ elimAutomaton f >>> second (arr LabeledArrow)
+
+        constantAutomaton = LabeledArrow . constantAutomaton . unLA
+
+instance (ArrowError ex a) => (ArrowError ex (LabeledArrow a)) where
+    raise = LabeledArrow raise
+    tryInUnless f g h = LabeledArrow $ tryInUnless (unLA f) (unLA g) (unLA h)
+
+instance (ArrowAddError ex a a') 
+    => ArrowAddError ex (LabeledArrow a) (LabeledArrow a')
+    where
+      liftError = LabeledArrow . liftError . unLA
+      elimError (LabeledArrow f) (LabeledArrow h) = 
+          LabeledArrow $ elimError f h
+
+instance (ArrowApply a) => ArrowApply (LabeledArrow a) where
+    app = LabeledArrow (first (arr unLA) >>> app)
+
+instance ArrowChoice a => ArrowChoice (LabeledArrow a) where
+    (+++) (LabeledArrow f) (LabeledArrow g) = 
+        LabeledArrow $ pushId 0 f +++ pushId 1 g
+
+    left f = f +++ arr id
+
+
+writeState l = LabeledArrow (proc i -> do
+               s <- readState -< ()
+               AT.lift (Kleisli (print)) -< (l,s))
+
+foo = (`runKleisli` ()) $ runLabeledArrow $ 
+      ( writeState "a" >>> writeState "b" >>> writeState "c")
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Jason Hart Priestley 2010
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Jason Hart Priestley nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
diff --git a/Web/Horse.hs b/Web/Horse.hs
new file mode 100644
--- /dev/null
+++ b/Web/Horse.hs
@@ -0,0 +1,12 @@
+module Web.Horse 
+    (module Text.Hamlet, module Web.Horse.Forms.Types, 
+     module Web.Horse.Forms.Basic, module Web.Horse.Forms, 
+     module Web.Horse.Hack, 
+     module Control.Arrow.Transformer.Automaton.Monad) where
+    
+import Text.Hamlet
+import Web.Horse.Forms.Types
+import Web.Horse.Forms.Basic
+import Web.Horse.Forms
+import Web.Horse.Hack
+import Control.Arrow.Transformer.Automaton.Monad
diff --git a/Web/Horse/Forms.hs b/Web/Horse/Forms.hs
new file mode 100644
--- /dev/null
+++ b/Web/Horse/Forms.hs
@@ -0,0 +1,128 @@
+{-#LANGUAGE Arrows, RankNTypes, ScopedTypeVariables, FlexibleContexts,
+  TypeSynonymInstances, NoMonomorphismRestriction, FlexibleInstances #-}
+
+module Web.Horse.Forms where
+
+import Web.Horse.Forms.Types
+import Web.Horse.Forms.Basic
+import Data.Monoid
+import Data.List.Split (splitOn)
+import Safe (readMay)
+import Text.Hamlet
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Data.Maybe
+import Data.Char
+import Control.Arrow.Transformer.All
+import Control.Arrow.Transformer.Automaton.Monad
+import Control.Arrow.Transformer.LabeledArrow
+import Control.Arrow.Operations hiding (write)
+
+import Debug.Trace
+
+valForm
+  :: (ArrowReader FormIn a',
+      ArrowAddLabel a a',
+      ArrowApply a'1,
+      ArrowAddAutomaton a' a'1,
+      ArrowChoice a') =>
+     String
+     -> a' String (Either String a1)
+     -> String
+     -> a () (Html (), Maybe a1)
+valForm initVal vtor label = withInput $
+    proc ((),nm,fi) -> do
+      s_curr <- keepState initVal -< fi
+      valid <- vtor -< s_curr
+      case valid of
+         Left err -> returnA -< (textField label (Just err) s_curr nm, 
+                                                   Nothing)
+         Right x -> returnA -< (textField label Nothing s_curr nm,
+                                Just x)
+
+stringForm = valForm "" (arr Right)
+
+readForm = valForm "" (arr (\x -> maybe (Left ("No read: " ++ x)) Right (readMay x)))
+
+enumForm label vs = withInput $
+    (proc ((),nm,fi) -> do
+       n_curr <- keepState (-1) -< extractNumber fi
+       let n_val = max n_curr 0
+           res = if n_curr < 0 then Nothing else (Just $ snd $ vs !! n_curr)
+       returnA -< (select label (map fst vs) n_val nm, res))
+           where
+             extractNumber i = checkBounds $ readMay =<< i
+
+             checkBounds Nothing = Nothing
+             checkBounds (Just k) = if k >= 0 && k < length vs 
+                                    then Just k else Nothing
+
+runSubStream :: (ArrowChoice a) => a i o -> a (Maybe i) (Maybe o)
+runSubStream f = proc i -> 
+                   case i of
+                          Just i' -> f >>> (arr Just) -< i'
+                          Nothing -> returnA -< Nothing
+
+filterDiffs
+  :: (Eq i, ArrowApply a', ArrowAddAutomaton a a') => a i (Maybe i)
+filterDiffs = monadToAuto $ \i1 -> do
+                i2 <- co (Just i1)
+                runFilter i1 i2
+              where
+                runFilter i1 = \i2 -> do
+                               case i1 == i2 of
+                                     True -> runFilter i1 =<< co Nothing
+                                     False -> runFilter i2 =<< co (Just i2)
+
+keepState :: (ArrowApply a', ArrowAddAutomaton a a') => o -> a (Maybe o) o
+keepState s0 = monadToAuto (f s0)
+               where
+                 f s0' ms1 = f (fromMaybe s0' ms1) =<< co (fromMaybe s0' ms1)
+
+
+replaceSecond
+  :: (ArrowAddAutomaton a a', ArrowApply a') =>
+     a i o -> a (i, Maybe (a i o)) o
+replaceSecond g = liftAutomaton $ 
+                  (proc (i,g_new) -> do
+                     let g_curr = elimAutomaton (fromMaybe g g_new)
+                     (o,g') <- g_curr -<< i
+                     returnA -< (o, replaceSecond g'))
+                                     
+once :: (ArrowAddAutomaton a a', ArrowApply a') => a1 -> a i (Maybe a1)
+once x = monadToAuto $ \_ -> co (Just x) >> forever (co (Nothing))
+
+auto :: Automaton a i o -> a i (o, Automaton a i o)
+auto (Automaton f) = f
+
+
+
+
+formSum _ [] _ = error "formSum requires at least one argument"
+
+formSum label fs def = catchAuto $ proc _ -> do
+  (fo,f) <- enumForm label fs -< ()
+  case f of
+    Just f' -> throwAuto -< f'
+    Nothing -> returnA -< setFormOut fo def
+
+
+throwAuto = proc f -> do
+              raise -< liftAutomaton $ LabeledArrow $
+                  (arr (flip (,) noInput) 
+                         >>> (unLA (newReader (elimAutomaton f))))
+
+linkForm linkName f = withInput $ proc ((),nm,iname) -> do
+              case iname of
+                Just _ -> throwAuto -< f
+                Nothing -> returnA -< (link linkName nm)
+
+
+
+staticUrls :: a -> [(String, a)] -> ([String] -> a)
+staticUrls def fs s = 
+    case lookup (filter (/= "") $ map (map toLower) s) 
+             (map ((filter (/= "") . splitOn "/") *** id) fs) of
+                    Nothing -> def
+                    Just f -> f
diff --git a/Web/Horse/Forms/Basic.hs b/Web/Horse/Forms/Basic.hs
new file mode 100644
--- /dev/null
+++ b/Web/Horse/Forms/Basic.hs
@@ -0,0 +1,51 @@
+{-#LANGUAGE ScopedTypeVariables, QuasiQuotes, OverloadedStrings #-}
+
+module Web.Horse.Forms.Basic where
+
+import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy.Char8 ()
+import Text.Hamlet
+import Data.Monoid
+
+textField :: String -> Maybe String -> String -> String -> Html ()
+textField label err val name = ($ undefined) $
+    [$hamlet| 
+     $maybe err e
+            %span.error $e$
+            %br
+     %label
+            $label$
+            %br
+            %input!type=text!value=$val$!name=$name$
+            %br|]
+
+link :: String -> String -> Html ()
+link linkName name = ($ undefined) $ [$hamlet|
+       %a!href="?$name$=1" $linkName$
+       %br|]
+
+select :: String -> [String] -> Int -> String -> Html ()
+select label options val name = ($ undefined) $  
+                                [$hamlet|
+     %label $label$
+        %br
+        %select!name=$name$
+           $forall opts opt
+              $if isSelected.opt
+                  %option!selected!value=$string.num.opt$ $string.optVal.opt$
+              $else
+                  %option!value=$string.num.opt$ $string.optVal.opt$
+        %br |]
+    where
+        opts = (zip3 (map (==val) [0..]) (map show [(0::Int)..]) options)
+        isSelected (x,_,_) = x
+        num (_,y,_) = y
+        optVal (_,_,z) = z
+
+
+
+wrapForm :: Html () -> Html ()
+wrapForm f = mconcat [preEscapedString "<form method='POST' action=''>", f, 
+               preEscapedString "<input type='submit'></input></form>"]
+
+
diff --git a/Web/Horse/Forms/Types.hs b/Web/Horse/Forms/Types.hs
new file mode 100644
--- /dev/null
+++ b/Web/Horse/Forms/Types.hs
@@ -0,0 +1,70 @@
+{-#LANGUAGE Arrows, TypeSynonymInstances, FlexibleInstances,
+  FlexibleContexts #-}
+
+module Web.Horse.Forms.Types where
+
+import Control.Arrow.Transformer.Automaton.Monad
+import Control.Arrow.Transformer.LabeledArrow
+import Text.Hamlet
+import Debug.Trace
+import Data.List
+import Control.Arrow
+import Control.Arrow.Transformer.All
+import Control.Arrow.Operations
+
+type FormOut = Html ()
+newtype FormIn = FormIn [(String,String)] deriving (Show)
+
+type HoH i o = LabeledArrow (ReaderArrow FormIn (Automaton (Kleisli IO))) i o
+
+type WithError ex i o = LabeledArrow (ErrorArrow ex (ReaderArrow FormIn (Automaton (Kleisli IO)))) i o
+
+noInput :: FormIn
+noInput = FormIn [] 
+
+filterPrefix :: String -> FormIn -> FormIn
+filterPrefix s (FormIn xss) = FormIn $ filter ((== s) . fst) xss
+
+class HasFormOut o where
+    getFormOut :: o -> FormOut
+    setFormOut :: FormOut -> o -> o
+
+instance HasFormOut FormOut where
+    getFormOut = id
+    setFormOut = const
+
+instance HasFormOut (FormOut, i) where
+    getFormOut (fo,_) = fo
+    setFormOut fo (_,o) = (fo,o)
+
+instance HasFormOut (FormOut, o1, o2) where
+    getFormOut (fo,_,_) = fo
+    setFormOut fo (_,o1,o2) = (fo,o1,o2)
+
+
+getSingle :: FormIn -> Maybe String
+getSingle (FormIn [(_,x)]) = Just x
+getSingle _ = Nothing
+
+withInput :: (ArrowReader FormIn a', ArrowAddLabel a a')
+             => a' (e,String,Maybe String) b -> a e b
+withInput f = runLabel $ proc (e,lab) -> do
+              fi <- readState -< ()
+              f -< (e,show lab,getSingle $ filterPrefix (show lab) fi)
+
+catchAuto
+  :: (ArrowAddAutomaton a a', 
+      ArrowApply a',
+      ArrowChoice a', 
+      ArrowChoice a) =>
+     (LabeledArrow (ErrorArrow (LabeledArrow a i o) a)) i o 
+         -> LabeledArrow a i o
+catchAuto f = liftAutomaton $
+              (LabeledArrow $
+               unLA (elimAutomaton f) 
+                >>> second (arr catchAuto)) `elimError` 
+              (LabeledArrow $ proc (i,f') -> 
+                   app -< (unLA (elimAutomaton f'), i))
+
+runHamlet :: (Arrow a) => a (x -> y) y
+runHamlet = arr ($ undefined)
diff --git a/Web/Horse/Hack.hs b/Web/Horse/Hack.hs
new file mode 100644
--- /dev/null
+++ b/Web/Horse/Hack.hs
@@ -0,0 +1,82 @@
+{-#LANGUAGE Arrows, RankNTypes, ScopedTypeVariables, 
+   NoMonomorphismRestriction #-}
+
+module Web.Horse.Hack where
+import Web.Horse.Forms
+import Text.Hamlet
+import Web.Horse.Forms.Types
+import Hack ( Env (..), Response (..) )
+import Hack.Contrib.Request (cookies, params, inputs, path)
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import Control.Concurrent.MVar
+import System.Random (randomIO)
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Data.List.Split (splitOn)
+import Control.Arrow.Transformer.Automaton
+import Control.Arrow.Transformer.Reader
+import Hack.Handler.EvHTTP (run)
+import Control.Arrow.Transformer.LabeledArrow
+import qualified Data.Map as M
+
+type Url = [String]
+
+runHorse f = runHorse1 run (simpleReqResp g)
+    where
+      g = runReader $ runLabeledArrow f >>> arr renderHtml
+
+runHorse1 :: ((Env -> IO Response) -> IO ()) -> 
+             Automaton (Kleisli IO) Env Response -> IO ()
+runHorse1 runner f = do
+  mv <- newMVar M.empty
+  runner (runWeb mv f)
+
+runWeb
+  :: MVar (M.Map String (MVar (Automaton (Kleisli IO) Env Response)))
+    -> Automaton (Kleisli IO) Env Response
+    -> Env
+    -> IO Response
+runWeb mv f0 req = do
+   (mv_sess, cookie) <- getSessionMVar mv f0 req
+   sess <- takeMVar mv_sess                          
+   (resp,sess') <- runKleisli (auto sess) req 
+   putMVar mv_sess sess'
+   return (resp{ headers= cookie ++ headers resp })  
+
+getSessionMVar
+ :: MVar (M.Map String (MVar a))
+    -> a
+    -> Env
+    -> IO (MVar a, [(String, String)])
+getSessionMVar mv f0 req = do
+  let sess = lookup sessionName (cookies req)
+  mp <- takeMVar mv
+  case join $ M.lookup <$> sess <*> (Just mp) of
+    Just val -> putMVar mv mp >> return (val,[])
+    Nothing -> do
+      (newSess :: Int) <- abs <$> randomIO
+      var <- newMVar f0
+      putMVar mv (M.insert (show newSess) var mp)
+      return (var, [("Set-Cookie", 
+                     sessionName ++ "=" ++ show newSess ++ "; path=/")]) 
+
+sessionName :: [Char]
+sessionName = "HaskellOnAHorse"
+
+
+
+simpleReqResp :: (Arrow a) => a (Url, FormIn) ByteString -> a Env Response
+simpleReqResp f = proc req -> do
+  let u = filter (/= "") $ splitOn "/" (path req)
+      fi = FormIn $ params req ++ inputs req
+  fo <- f -< (u,fi)
+  returnA -< asResponse fo
+
+asResponse :: ByteString -> Response
+asResponse out = Response { status=200, headers=[typ,len], body = out }
+    where
+      typ = ("Content-Type", "text/html")
+      len = ("Content-Length", show $ LB.length out)
+
diff --git a/on-a-horse.cabal b/on-a-horse.cabal
new file mode 100644
--- /dev/null
+++ b/on-a-horse.cabal
@@ -0,0 +1,69 @@
+-- on-a-horse.cabal auto-generated by cabal init. For additional
+-- options, see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                on-a-horse
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version:             0.1
+
+-- A short (one-line) description of the package.
+Synopsis:            "Haskell on a Horse" - A combinatorial web framework
+
+-- A longer description of the package.
+Description:         Please read the introduction at http://haskell.on-a-horse.org
+
+-- URL for the project homepage or repository.
+Homepage:            haskell.on-a-horse.org
+
+-- The license under which the package is released.
+License:             BSD3
+
+-- The file containing the license text.
+License-file:        LICENSE
+
+-- The package author(s).
+Author:              Jason Hart Priestley
+
+-- An email address to which users can send suggestions, bug reports,
+-- and patches.
+Maintainer:          jason@on-a-horse.org
+
+-- A copyright notice.
+-- Copyright:           
+
+-- Stability of the pakcage (experimental, provisional, stable...)
+Stability:           Experimental
+
+Category:            Web
+
+Build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+Extra-source-files:  tutorial.lhs
+
+-- Constraint on the version of Cabal needed to build this package.
+Cabal-version:       >=1.2
+
+
+Library
+  -- Modules exported by the library.
+  Exposed-modules:     Web.Horse, Control.Arrow.Transformer.LabeledArrow,
+                       Control.Arrow.Transformer.Automaton.Monad
+  
+  -- Packages needed in order to build this package.
+  Build-depends: base >= 4 && < 5, safe, split, hamlet, hack, 
+                 hack-handler-evhttp, hack-contrib, containers, 
+                 arrows, mtl, random, bytestring
+  
+  -- Modules not exported by this package.
+  Other-modules:       Web.Horse.Forms, Web.Horse.Hack, 
+                       Web.Horse.Forms.Basic, Web.Horse.Forms.Types
+  
+  
+  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+  -- Build-tools:         
+  
diff --git a/tutorial.lhs b/tutorial.lhs
new file mode 100644
--- /dev/null
+++ b/tutorial.lhs
@@ -0,0 +1,269 @@
+Haskell on a Horse
+==================
+
+ <style>
+	body{ margin-left:40px; margin-right: 15%; text-align: justify; }
+	.error{ color: red; }
+	h1,h2 { font-family; sans-serif; font-weight: normal; color: #222; }
+	h1{ font-size: 22pt; border-bottom: double }
+	h2{ font-size: 18pt; border-bottom: 3px dotted }
+
+	.oper{ border: 1px solid; padding: 4px; }
+
+	.sourceCode{ background-color: #eee; border: 1px dotted #666; 
+			padding: 8px; width: 100%; }
+	.example{ background-color: #eee; width: 100%; 
+				border-collapse: collapse; }
+	.example td { border: 1px dotted #666; padding: 8px; }
+	.example .sourceCode{ border: none; padding: 0; }
+ </style>
+
+Haskell on a Horse (HoH) is a combinatorial web framework for the
+programming language Haskell.  It is currently at an early, unsettled
+stage of development.  It is available under the "BSD3" open-source
+license.
+
+Installing and Using HoH
+------------------------
+
+    cabal install on-a-horse
+
+> {-#LANGUAGE Arrows, QuasiQuotes, ScopedTypeVariables #-}
+> import Web.Horse 
+> import Control.Applicative
+> import Control.Arrow
+> import Control.Monad
+> import Control.Monad.Cont
+> import Data.Maybe
+> import Data.Monoid
+> import Data.List.Split (splitOn)
+> import Control.Arrow.Transformer.All
+> import Text.Pandoc
+
+Atomic Components
+-------------------
+
+An HoH application is built up from atomic components.  A component is
+a complete HoH application all by itself: it can render itself, and
+respond to input.
+
+ <table class="example"><tr><td>
+
+> 
+> ex1 = proc url -> do
+>     (fo,num::Maybe Integer) <- readForm "enter a number" -< ()
+>     returnA -< wrapForm fo
+> 
+
+ </td><td>EXAMPLE</td></tr></table>
+
+run this as a web app on port 8080 using
+
+~~~~~~~~{.haskell}
+main = runHorse ex1
+~~~~~~~~
+
+Side-by-Side Components
+--------------------------
+
+Components can be rendered side-by-side within a page.
+
+ <table class=example><tr><td>
+
+> ex2 :: HoH Url (Html ())
+> ex2 =  proc url -> do
+>               (fo1, oper) <- enumForm "operation" 
+>                           [("times", (*)),
+>                            ("plus", (+))] -< ()
+>               (fo2, x::Maybe Integer) <- readForm "x" -< ()
+>               (fo3, y::Maybe Integer) <- readForm "y" -< ()
+>               let result = show <$> (oper <*> x <*> y)
+>               runHamlet -< [$hamlet|
+>                             %form!method=POST!action=""
+>                                Calculate a number!
+>                                %br
+>                                $fo1$ $fo2$ $fo3$
+>                                Result:
+>                                $maybe result res
+>                                       $res$
+>                                %br
+>                                %input!type=submit  |]
+
+ </td><td>EXAMPLE</td></tr></table>
+
+Replacing one Component With Another
+---------------------------------------
+
+Components can be replaced.  A call to the arrow `throwAuto` will
+replace the nearest enclosing `catchAuto`.  The new component will be
+called immediately, with no form input.
+
+~~~~~~{.haskell}
+formSum label fs def = catchAuto $ proc _ -> do
+  (fo,f) <- enumForm label fs -< ()
+  case f of
+    Just f' -> throwAuto -< f'
+    Nothing -> returnA -< setFormOut fo def
+~~~~~~
+
+Note: `def` is a default value to be used when no form is yet
+selected.
+
+ <table class=example><tr><td>
+
+> ex3 :: HoH Url (Html ())
+> ex3 = formSum "example to run" [("example 1",ex1),("example 2",ex2)] mempty
+>       >>> arr wrapForm
+
+ </td><td>EXAMPLE</td></tr></table>
+
+A More Complex Example
+-------------------------
+
+By combining the techniques above, sophisticated pages can be made
+with little code.  
+
+ <table class=example><tr><td>
+
+> ex4 = proc url -> do
+>      (fo,result) <- term "expression" -< ()
+>      runHamlet -< [$hamlet|
+>             %form!method=POST!action=""
+>                $fo$
+>                Result:
+>                $maybe result res
+>                       $show res$ 
+>                %input!type=submit
+>                %br |]
+>    where
+>        term :: String -> HoH () (FormOut, Maybe Integer)
+>        term label = catchAuto $ formSum label 
+>             [("number", number label),
+>              ("add",oper label "add" (+)),
+>              ("multiply",oper label "multiply" (*))] (mempty, Nothing)
+>
+>        number :: String -> WithError (HoH () (FormOut, Maybe Integer)) 
+>                                           () (FormOut, Maybe Integer)
+>        number termLabel = proc () -> do
+>               fo1 <- linkForm "cancel" (term termLabel) -< ()
+>               (fo2,x) <- readForm "number" -< ()
+>               returnA -< (fo1 `mappend` fo2, x)
+>
+>        oper termLabel label f = proc () -> do
+>             (fo1) <- linkForm "cancel" (term termLabel) -< ()
+>             (fo2,x) <- liftError (term "x") -< ()
+>             (fo3,y) <- liftError (term "y") -< ()
+>             out <- runHamlet -< [$hamlet|
+>                 %div.oper
+>                        $fo1$
+>                        $label$
+>                        %br
+>                        $fo2$ $fo3$ |]
+>             returnA -< (out, f <$> x <*> y)
+
+ </td><td>EXAMPLE</td></tr></table>
+
+Notes: 
+
+* `throwAuto` works by adding an ErrorArrow to its argument.
+When it is called recursively, as in the example above, `liftError`
+may be required to avoid an infinite type.
+
+* `linkForm` acts much like `throwAuto`, except that it waits to throw
+its argument until the link it renders has been clicked.
+
+
+
+
+Building Atomic Components
+-------------------------
+
+Atomic components should generally use the 'withInput' function.  This
+will add two inputs to an arrow: the first is a unique label for the
+component, and the second is the current input to the arrow, or
+Nothing if there is no input.  The label should be used as a name in
+any form input or query parameters.  Here is the code for `linkForm`.
+
+~~~~~~{.haskell}
+linkForm linkName f = withInput $ proc ((),nm,iname) -> do
+              case iname of
+                Just _ -> throwAuto -< f
+                Nothing -> returnA -< (link linkName nm)
+~~~~~~
+
+(`link "name" "label"` produces `<a href="?label=1">name</a>`)
+
+
+Handling urls
+-------------
+
+`runHorse` sends the URL as the sole argument to the handler.  A
+function, `dispatch`, is available to construct multi-page
+applications.
+
+
+ 
+ <table class="example"><tr><td>
+
+> ex5 = proc url -> do
+>            (dispatch $ staticUrls fourOhFour $
+>              [("", urls),
+>               ("ex1", ex1),
+>               ("ex2", ex2),
+>               ("ex3", ex3),
+>               ("ex4", ex4)]) -< (url,url)
+
+ </td><td>EXAMPLE</td></tr></table>
+
+> fourOhFour = proc url -> do
+>                runHamlet -< [$hamlet| Page not found |]
+
+> urls = proc url -> do
+>         runHamlet -< [$hamlet|
+>                       %a!href=ex1 example 1
+>                       %br
+>                       %a!href=ex2 example 2
+>                       %br
+>                       %a!href=ex3 example 3
+>                       %br
+>                       %a!href=ex4 example 4
+>                       %br
+>                       %a!href=ex5 example 5
+>                       %br |]
+>
+
+Running the Tutorial
+--------------------
+
+This tutorial is a sort of self-executing markdown (pandoc) file.
+This is the code to run it.
+
+> main = do
+>   tut <- readFile "tutorial.lhs"
+>   tmpl <- getDefaultTemplate Nothing "html"
+>   let pd = readMarkdown defaultParserState{ stateLiterateHaskell=True } tut
+>   let tut' = writeHtmlString defaultWriterOptions{
+>               writerStandalone=True,
+>               writerTemplate= either (error . show) id tmpl
+>               } pd
+>   let ts = map preEscapedString $ splitOn ("EXA"++"MPLE") tut'
+>   runHorse $ proc url -> do
+>          fo1 <- ex1 -< url
+>          fo2 <- ex2 -< url
+>          fo3 <- ex3 -< url
+>          fo4 <- ex4 -< url
+>          fo5 <- ex5 -< url
+>          let vals = interleave ts [fo1,fo2,fo3,fo4,fo5]
+>          runHamlet -< [$hamlet|
+>                     $forall vals val
+>                         $val$ |]
+
+> interleave (x:xs) (y:ys) = (x:y:interleave xs ys)
+> interleave [] ys = ys
+> interleave xs [] = xs
+
+ <b>
+
+> -- Jason Hart Priestley, July 26, 2010. (jason @ this domain)
+
+ </b>