diff --git a/CHANGES.txt b/CHANGES.txt
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,3 +1,6 @@
 Changelog for Bake
 
+0.1
+    Works to some level
+0.0
     Initial version, not ready for public use
diff --git a/Development/Bake.hs b/Development/Bake.hs
deleted file mode 100644
--- a/Development/Bake.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-
--- | Define a continuous integration system.
-module Development.Bake(
-    -- * Execute
-    bake,
-    -- * Central types
-    Candidate(..), Oven(..), TestInfo,
-    defaultOven, run,
-    -- ** TestInfo mutators
-    threads, threadsAll, before, beforeClear, require,
-    -- * Operations
-    startServer, startClient,
-    module Development.Bake.Send,
-    -- * Utility types
-    Host, Port
-    ) where
-
-import Development.Bake.Type
-import Development.Bake.Server.Start
-import Development.Bake.Client
-import Development.Bake.Args
-import Development.Bake.Send
diff --git a/Development/Bake/Args.hs b/Development/Bake/Args.hs
deleted file mode 100644
--- a/Development/Bake/Args.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}
-{-# OPTIONS_GHC -fno-warn-missing-fields #-}
-
--- | Define a continuous integration system.
-module Development.Bake.Args(
-    bake
-    ) where
-
-import System.Console.CmdArgs
-import Development.Bake.Type
-import Development.Bake.Client
-import Development.Bake.Server.Start
-import Development.Bake.Send
-
-
-type HostPort = String
-
-data Bake
-    = Server {port :: Port, author :: Author, name :: String}
-    | Client {server :: HostPort, author :: Author, name :: String, threads :: Int, provide :: [String]}
-    | AddPatch {server :: HostPort, author :: Author, name :: String}
-    | DelPatch {server :: HostPort, author :: Author, name :: String}
-    | DelPatches {server :: HostPort, author :: Author}
-    | Pause {server :: HostPort, author :: Author}
-    | Unpause {server :: HostPort, author :: Author}
-    | Run {output :: FilePath, test :: String, state :: String, patch :: [String]}
-      deriving (Typeable,Data)
-
-
-bakeMode = cmdArgsMode $ modes
-    [Server{port = 80, author = "unknown"}
-    ,Client{server = "", name = "", threads = 0, provide = []}
-    ,AddPatch{}
-    ,DelPatch{}
-    ,DelPatches{}
-    ,Pause{}
-    ,Unpause{}
-    ,Run "" "" "" []
-    ]
-
-bake :: (Show state, Read state, Show patch, Read patch, Show test, Read test)
-     => Oven state patch test -> IO ()
-bake oven = do
-    x <- cmdArgsRun bakeMode
-    case x of
-        Server{..} -> startServer port author name oven
-        Client{..} -> startClient (hp server) author name provide threads
-        AddPatch{..} -> sendAddPatch (hp server) author name
-        DelPatch{..} -> sendDelPatch (hp server) author name
-        DelPatches{..} -> sendDelAllPatches (hp server) author
-        Pause{..} -> sendPause (hp server) author
-        Unpause{..} -> sendUnpause (hp server) author
-        Run{..} -> do
-            let TestInfo{..} = ovenRunTest oven (Candidate (read state) (map read patch)) (read test)
-            writeFile output . show =<< testAction
-    where
-        hp "" = ovenDefaultServer oven
-        hp s = (h, read $ drop 1 p)
-            where (h,p) = break (== ':') s
diff --git a/Development/Bake/Client.hs b/Development/Bake/Client.hs
deleted file mode 100644
--- a/Development/Bake/Client.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-
--- | Define a continuous integration system.
-module Development.Bake.Client(
-    startClient
-    ) where
-
-import Development.Bake.Type
-import Development.Bake.Util
-import Development.Bake.Message
-import System.Exit
-import Development.Shake.Command
-import Control.Concurrent
-import Control.Monad
-
-
--- given server, name, threads
-startClient :: (Host,Port) -> Author -> String -> [String] -> Int -> IO ()
-startClient hp author name provides threads = do
-    cookie <- newCookie
-
-    let process xs = do
-            forM_ xs $ \(Reply can test) -> forkIO $ withTempFile "bake.txt" $ \file -> do
-                (time, (exit, Stdout stdout)) <- timed $ cmd "self" (("--output=" ++ file):undefined)
-                info <- case exit of
-                    ExitFailure i -> return $ Left i
-                    ExitSuccess -> fmap (Right . map Test . lines) $ readFile file
-                sendMessage hp $ Finished can cookie test stdout time info
-                ping
-
-        ping = process =<< sendMessage hp (Ping author name cookie provides threads)
-
-    forever $ ping >> sleep 60
diff --git a/Development/Bake/Email.hs b/Development/Bake/Email.hs
deleted file mode 100644
--- a/Development/Bake/Email.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-
-module Development.Bake.Email(ovenEmail) where
-
-import Development.Bake.Type
-
-
-ovenEmail :: (Host,Port) -> Oven state patch test -> Oven state (patch, [String]) test
-ovenEmail = undefined
diff --git a/Development/Bake/Git.hs b/Development/Bake/Git.hs
deleted file mode 100644
--- a/Development/Bake/Git.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-
-module Development.Bake.Git(SHA1, ovenGit) where
-
-import Development.Bake.Type
-
-newtype SHA1 = SHA1 String deriving (Read,Show)
-
-
--- | Given a repo name, and a set of tests, produce something that runs from git
-ovenGit :: String -> String -> Oven SHA1 SHA1 test -> Oven SHA1 SHA1 test
-ovenGit repo branch = undefined
diff --git a/Development/Bake/Message.hs b/Development/Bake/Message.hs
deleted file mode 100644
--- a/Development/Bake/Message.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-
--- | Define a continuous integration system.
-module Development.Bake.Message(
-    Message(..), Reply(..), sendMessage, fromPayload
-    ) where
-
-import Development.Bake.Type
-import Development.Bake.Web
-
-data Message
-    -- Send by the user
-    = AddPatch Author Patch
-    | DelPatch Author Patch
-    | DelAllPatches Author
-    | Pause Author
-    | Unpause Author
-    -- Sent by the client
-    | Ping Author String String [String] Int -- name, cookie, provides, threads
-    | Finished (Candidate State Patch) String (Maybe Test) String Double (Either Int [Test])
-                                       -- stdout time   result
-
-data Reply = Reply (Candidate State Patch) (Maybe Test)
-
-toPayload :: Message -> Payload
-toPayload = undefined
-
-
-fromPayload :: Payload -> Message
-fromPayload = undefined
-
-
-sendMessage :: (Host,Port) -> Message -> IO [Reply]
-sendMessage hp msg = do
-    send hp $ toPayload msg
-    return []
diff --git a/Development/Bake/Send.hs b/Development/Bake/Send.hs
deleted file mode 100644
--- a/Development/Bake/Send.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-
-module Development.Bake.Send(
-    sendPause, sendUnpause,
-    sendAddPatch, sendDelPatch, sendDelAllPatches
-    ) where
-
-import Control.Monad
-import Development.Bake.Type
-import Development.Bake.Message
-
-sendPause :: (Host,Port) -> Author -> IO ()
-sendPause hp author = void $ sendMessage hp $ Pause author
-
-sendUnpause :: (Host,Port) -> Author -> IO ()
-sendUnpause hp author = void $ sendMessage hp $ Unpause author
-
-sendAddPatch :: Show patch => (Host,Port) -> Author -> patch -> IO ()
-sendAddPatch hp author x = void $ sendMessage hp $ AddPatch author $ Patch $ show x
-
-sendDelPatch :: Show patch => (Host,Port) -> Author -> patch -> IO ()
-sendDelPatch hp author x = void $ sendMessage hp $ DelPatch author $ Patch $ show x
-
-sendDelAllPatches :: (Host,Port) -> Author -> IO ()
-sendDelAllPatches hp author = void $ sendMessage hp $ DelAllPatches author
diff --git a/Development/Bake/Server/Start.hs b/Development/Bake/Server/Start.hs
deleted file mode 100644
--- a/Development/Bake/Server/Start.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
--- | Define a continuous integration system.
-module Development.Bake.Server.Start(
-    startServer
-    ) where
-
-import Development.Bake.Type
-import Development.Bake.Web
-import Data.IORef
-import Development.Bake.Server.Type
-
-
-startServer :: (Show state, Read state, Show patch, Read patch, Show test, Read test)
-            => Port -> Author -> String -> Oven state patch test -> IO ()
-startServer port author name oven = do
-    s <- ovenUpdateState (concrete oven) Nothing
-    ref <- newIORef $ defaultServer s
-    server port $ \Payload{..} -> undefined
diff --git a/Development/Bake/Server/Type.hs b/Development/Bake/Server/Type.hs
deleted file mode 100644
--- a/Development/Bake/Server/Type.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-
--- | Define a continuous integration system.
-module Development.Bake.Server.Type(
-    Server(..), defaultServer, History(..), Running(..)
-    ) where
-
-import Development.Bake.Type
-
-defaultServer :: State -> Server
-defaultServer s = Server [] [] [] (Candidate s [])
-
-data Server = Server
-    {history :: [History]
-    ,running :: [Running]
-    ,alias :: [(State, Candidate State Patch)]
-    ,active :: Candidate State Patch
-    }
-
-data History = History (Candidate State Patch) (Maybe Test) FilePath Double (Either Int [TestInfo Test])
-
-data Running = Running (Candidate State Patch) (Maybe Test) Double String
-
-
-
-{-
-do
-    process $ \    = AddPatch Author Patch
-    | DelPatch Author Patch
-    | DelAllPatches Author
-    | Pause Author
-    | Unpause Author
-    -- Sent by the client
-    | Ping Author String String Int -- name, cookie, threads
-    | Finished (Candidate State Patch) (Maybe Test) String Double (Either Int [TestInfo Test])
-
-
-newtype Sever = Server
-    {history :: [History]
-    ,alias :: [(State, Candidate State Patch)]
-    ,current :: Candidate State Patch
-    ,active :: [()]
-    }
-
--}
diff --git a/Development/Bake/Type.hs b/Development/Bake/Type.hs
deleted file mode 100644
--- a/Development/Bake/Type.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-
--- | Define a continuous integration system.
-module Development.Bake.Type(
-    Host, Port,
-    Candidate(..), Oven(..), TestInfo(..), defaultOven,
-    threads, threadsAll, before, beforeClear, run, require,
-    State(..), Patch(..), Test(..), concrete,
-    Author
-    ) where
-
-type Author = String
-
-type Host = String
-
-type Port = Int
-
-data Candidate state patch = Candidate state [patch]
-
-data Oven state patch test = Oven
-    {ovenUpdateState :: Maybe (Candidate state patch) -> IO state
-        -- ^ Given a state, and a set of candiates that have passed,
-        --   merge to create a new state.
-    ,ovenRunTest :: Candidate state patch -> Maybe test -> TestInfo test
-        -- ^ Produce information about a test
-    ,ovenPatchReject :: patch -> Maybe test -> IO ()
-        -- ^ A patch has been marked as failing, tell everyone.
-    ,ovenPatchExtra :: patch -> IO String
-        -- ^ Extra information about the patch
-    ,ovenDefaultServer :: (Host, Port)
-        -- ^ Default server to use
-    }
-
-defaultOven :: Oven state patch test
-defaultOven = Oven
-    (error "defaultOven.ovenUpdateState") (error "defaultOven.ovenRunTest")
-    (\_ _ -> return ()) (\_ -> return "") ("",0)
-
-data TestInfo test = TestInfo
-    {testThreads :: Maybe Int -- number of threads, defaults to 1, Nothing for use all
-    ,testAction :: IO [test]
-    ,testBefore :: [test]
-    ,testBeforeAuto :: Bool
-    ,testRequire :: [String]
-    }
-
-require :: String -> TestInfo test -> TestInfo test
-require x t = t{testRequire=x:testRequire t}
-
-threads :: Int -> TestInfo test -> TestInfo test
-threads j t = t{testThreads=Just j}
-
-threadsAll :: TestInfo test -> TestInfo test
-threadsAll t = t{testThreads=Nothing}
-
-before :: [test] -> TestInfo test -> TestInfo test
-before xs t = t{testBefore=testBefore t++xs}
-
-beforeClear :: TestInfo test -> TestInfo test
-beforeClear t = t{testBefore=[], testBeforeAuto=False}
-
-run :: IO [test] -> TestInfo test
-run act = TestInfo (Just 1) act [] True []
-
-
-newtype State = State String
-newtype Patch = Patch String
-newtype Test = Test String
-
-concrete :: (Show state, Read state, Show patch, Read patch, Show test, Read test)
-         => Oven state patch test -> Oven State Patch Test
-concrete = undefined
diff --git a/Development/Bake/Util.hs b/Development/Bake/Util.hs
deleted file mode 100644
--- a/Development/Bake/Util.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-
-module Development.Bake.Util(
-    sleep, newCookie, timed, withTempFile
-    ) where
-
-
-sleep :: Double -> IO ()
-sleep = undefined
-
-
-newCookie :: IO String
-newCookie = undefined
-
-
-timed :: IO a -> IO (Double, a)
-timed = undefined
-
-
-withTempFile :: String -> (FilePath -> IO ()) -> IO ()
-withTempFile = undefined
diff --git a/Development/Bake/Web.hs b/Development/Bake/Web.hs
deleted file mode 100644
--- a/Development/Bake/Web.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-
-module Development.Bake.Web(
-    Payload(..), send, server
-    ) where
-
-import Development.Bake.Type
-
-
-data Payload = Payload
-    {payloadURL :: String
-    ,payloadArgs :: [(String, String)]
-    ,payloadBody :: String
-    }
-
-send :: (Host,Port) -> Payload -> IO String
-send = undefined
-
-
-server :: Port -> (Payload -> IO (Either FilePath String)) -> IO ()
-server = undefined
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -28,7 +28,3 @@
 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.
-
-
-Some of the JavaScript files in html/ have different copyright and licenses.
-Please consult the corresponding source file in js-src/
diff --git a/bake.cabal b/bake.cabal
--- a/bake.cabal
+++ b/bake.cabal
@@ -1,20 +1,25 @@
 cabal-version:      >= 1.10
 build-type:         Simple
 name:               bake
-version:            0.0
+version:            0.1
 license:            BSD3
 license-file:       LICENSE
 category:           Development
 author:             Neil Mitchell <ndmitchell@gmail.com>
 maintainer:         Neil Mitchell <ndmitchell@gmail.com>
 copyright:          Neil Mitchell 2014
-synopsis:           Continuous integration library.
+synopsis:           Continuous integration system
 description:
-    Used for large scale continuous integration.
-    NOT READY FOR USE BY ANYONE - HALF THE FUNCTIONS ARE UNDEFINED!
+    Bake is a continuous integration server, designed for large, productive, semi-trusted teams.
+    .
+    * /Large teams/ where there are at least several contributors working full-time on a single code base.
+    .
+    * /Productive teams/ which are regularly pushing code, many times a day.
+    .
+    * /Semi-trusted teams/ where code does not go through manual code review, but code does need to pass a test suite and perhaps some static analysis. People are assumed not to be malicious, but are fallible.
 homepage:           https://github.com/ndmitchell/bake#readme
 bug-reports:        https://github.com/ndmitchell/bake/issues
-tested-with:        GHC==7.8.2, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2
+tested-with:        GHC==7.8.2, GHC==7.6.3
 
 extra-source-files:
     CHANGES.txt
@@ -25,23 +30,64 @@
 
 library
     default-language: Haskell2010
+    hs-source-dirs: src
     build-depends:
         base == 4.*,
         cmdargs >= 0.10,
-        shake >= 0.10
+        shake >= 0.10,
+        directory,
+        bytestring,
+        text,
+        time,
+        random,
+        HTTP,
+        http-types,
+        deepseq,
+        aeson,
+        extra >= 0.2,
+        wai >= 3.0.1,
+        warp >= 3.0
 
     exposed-modules:
         Development.Bake
-        Development.Bake.Git
-        Development.Bake.Email
 
     other-modules:
         Development.Bake.Args
         Development.Bake.Client
+        Development.Bake.Email
+        Development.Bake.Format
+        Development.Bake.Git
         Development.Bake.Message
         Development.Bake.Send
+        Development.Bake.Server.Brains
         Development.Bake.Server.Start
         Development.Bake.Server.Type
+        Development.Bake.Server.Web
         Development.Bake.Type
-        Development.Bake.Util
         Development.Bake.Web
+
+-- don't use 'cabal test' since that loses the child stdout
+executable bake-test
+    default-language: Haskell2010
+    hs-source-dirs: src
+    main-is: Test.hs
+    other-modules: Example
+    ghc-options: -threaded -main-is Test.main
+    build-depends:
+        base == 4.*,
+        cmdargs >= 0.10,
+        shake >= 0.10,
+        directory,
+        bytestring,
+        text,
+        time,
+        random,
+        HTTP,
+        http-types,
+        deepseq,
+        aeson,
+        extra >= 0.2,
+        wai >= 3.0.1,
+        warp >= 3.0,
+        process,
+        filepath
diff --git a/src/Development/Bake.hs b/src/Development/Bake.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake.hs
@@ -0,0 +1,27 @@
+
+-- | A continuous integration system. For an example of how to get started
+--   see <https://github.com/ndmitchell/bake#readme>.
+module Development.Bake(
+    -- * Execute
+    bake,
+    -- * Central types
+    Oven(..), defaultOven,
+    Stringy(..), readShowStringy,
+    -- ** Oven modifiers
+    ovenTest, ovenGit, ovenNotifyStdout, ovenNotifyEmail,
+    -- ** TestInfo members
+    TestInfo, run, threads, threadsAll, require, suitable,
+    -- * Operations
+    startServer, startClient,
+    module Development.Bake.Send,
+    -- * Utility types
+    Host, Port, Author
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Server.Start
+import Development.Bake.Client
+import Development.Bake.Args
+import Development.Bake.Send
+import Development.Bake.Git
+import Development.Bake.Email
diff --git a/src/Development/Bake/Args.hs b/src/Development/Bake/Args.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Args.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Args(
+    bake
+    ) where
+
+import System.Console.CmdArgs
+import Development.Bake.Type hiding (Client)
+import Development.Bake.Client
+import Development.Bake.Server.Start
+import Development.Bake.Send
+import Control.Exception.Extra
+import Control.DeepSeq
+import Data.Maybe
+import Control.Monad.Extra
+
+
+type HostPort = String
+
+data Bake
+    = Server {port :: Maybe Port, author :: Author, name :: String, timeout :: Double}
+    | Client {server :: HostPort, author :: Author, name :: String, threads :: Int, ping :: Double}
+    | AddPatch {server :: HostPort, author :: Author, name :: String}
+    | DelPatch {server :: HostPort, author :: Author, name :: String}
+    | DelPatches {server :: HostPort, author :: Author}
+    | Pause {server :: HostPort, author :: Author}
+    | Unpause {server :: HostPort, author :: Author}
+    | Run {output :: FilePath, test :: Maybe String, state :: String, patch :: [String]}
+      deriving (Typeable,Data)
+
+
+bakeMode = cmdArgsMode $ modes
+    [Server{port = Nothing, author = "unknown", name = "", timeout = 5*60}
+    ,Client{server = "", threads = 1, ping = 60}
+    ,AddPatch{}
+    ,DelPatch{}
+    ,DelPatches{}
+    ,Pause{}
+    ,Unpause{}
+    ,Run "" Nothing "" []
+    ] &= verbosity
+
+-- | The entry point to the system. Usually you will define:
+--
+-- > main = bake myOven
+--
+--   Where @myOven@ defines details about the server. The program
+--   deals with command line arguments, run @--help@ for details.
+bake :: Oven state patch test -> IO ()
+bake oven@Oven{..} = do
+    x <- cmdArgsRun bakeMode
+    case x of
+        Server{..} -> startServer (fromMaybe (snd ovenServer) port) author name timeout oven
+        Client{..} -> startClient (hp server) author name threads ping oven
+        AddPatch{..} -> sendAddPatch (hp server) author =<< check "patch" ovenStringyPatch name
+        DelPatch{..} -> sendDelPatch (hp server) author =<< check "patch" ovenStringyPatch name
+        DelPatches{..} -> sendDelAllPatches (hp server) author
+        Pause{..} -> sendPause (hp server) author
+        Unpause{..} -> sendUnpause (hp server) author
+        Run{..} -> do
+            case test of
+                Nothing -> do
+                    res <- ovenPrepare
+                        (stringyFrom ovenStringyState state)
+                        (map (stringyFrom ovenStringyPatch) patch)
+                    (yes,no) <- partitionM (testSuitable . ovenTestInfo) res
+                    let op = map (stringyTo ovenStringyTest)
+                    writeFile output $ show (op yes, op no)
+                Just test -> do
+                    testAction $ ovenTestInfo $ stringyFrom ovenStringyTest test
+    where
+        hp "" = ovenServer
+        hp s = (h, read $ drop 1 p)
+            where (h,p) = break (== ':') s
+
+
+check :: String -> Stringy s -> String -> IO String
+check typ Stringy{..} x = do
+    res <- try_ $ evaluate $ force $ stringyTo $ stringyFrom x
+    case res of
+        Left err -> error $ "Couldn't stringify the " ++ typ ++ " " ++ show x ++ ", got " ++ show err
+        Right v -> return v
+
+
diff --git a/src/Development/Bake/Client.hs b/src/Development/Bake/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Client.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE RecordWildCards, ViewPatterns, ScopedTypeVariables #-}
+
+module Development.Bake.Client(
+    startClient
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Message
+import System.Exit
+import Control.Exception.Extra
+import Development.Shake.Command
+import Control.Concurrent
+import Control.Monad.Extra
+import System.Time.Extra
+import Data.IORef
+import Data.Maybe
+import System.Environment
+import System.Directory
+
+
+-- given server, name, threads
+startClient :: (Host,Port) -> Author -> String -> Int -> Double -> Oven state patch test -> IO ()
+startClient hp author (Client -> client) maxThreads ping (concrete -> oven) = do
+    queue <- newChan
+    nowThreads <- newIORef maxThreads
+
+    root <- myThreadId
+    exe <- getExecutablePath
+    let safeguard = handle_ (throwTo root)
+    forkIO $ safeguard $ forever $ do
+        readChan queue
+        now <- readIORef nowThreads
+        q <- sendMessage hp $ Pinged $ Ping client author maxThreads now
+        whenJust q $ \q@Question{..} -> do
+            atomicModifyIORef nowThreads $ \now -> (now - qThreads, ())
+            writeChan queue ()
+            void $ forkIO $ safeguard $ do
+                dir <- candidateDir qCandidate
+                (time, (exit, Stdout sout, Stderr serr)) <- duration $
+                    cmd (Cwd dir) exe "run"
+                        "--output=../tests.txt"
+                        ["--test=" ++ fromTest t | Just t <- [qTest]]
+                        ("--state=" ++ fromState (fst qCandidate))
+                        ["--patch=" ++ fromPatch p | p <- snd qCandidate]
+                tests <- if isJust qTest || exit /= ExitSuccess then return ([],[]) else do
+                    src ::  ([String],[String]) <- fmap read $ readFile "tests.txt"
+                    let op = map (stringyFrom (ovenStringyTest oven))
+                    putStrLn "FIXME: Should validate the next set forms a DAG"
+                    return (op (fst src), op (snd src))
+                atomicModifyIORef nowThreads $ \now -> (now + qThreads, ())
+                sendMessage hp $ Finished q $
+                    Answer (sout++serr) time tests $ exit == ExitSuccess
+                writeChan queue ()
+
+    forever $ writeChan queue () >> sleep ping
+
+
+-- | Find a directory for this patch
+candidateDir :: (State, [Patch]) -> IO FilePath
+candidateDir (s, ps) = do
+    let file = "candidates.txt"
+    let c_ = (fromState s, map fromPatch ps)
+    b <- doesFileExist file
+    src :: [((String, [String]), FilePath)] <- if b then fmap read $ readFile file else return []
+    case lookup c_ src of
+        Just p -> return p
+        Nothing -> do
+            let res = show $ length src
+            createDirectoryIfMissing True res
+            writeFile "candidates.txt" $ show $ (c_,res):src
+            return res
diff --git a/src/Development/Bake/Email.hs b/src/Development/Bake/Email.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Email.hs
@@ -0,0 +1,13 @@
+
+module Development.Bake.Email(ovenNotifyEmail) where
+
+import Development.Bake.Type
+
+
+-- | Email notifications when users should be notified about success/failure.
+--   Requires the host/port of an SMTP server. Not yet implemented, will always crash.
+ovenNotifyEmail :: (Host,Port) -> Oven state patch test -> Oven state patch test
+ovenNotifyEmail hp o = o{ovenNotify = \a s -> sendEmail hp a s >> ovenNotify o a s}
+
+sendEmail :: (Host,Port) -> [Author] -> String -> IO ()
+sendEmail = error "Bake.sendEmail not yet implemented"
diff --git a/src/Development/Bake/Format.hs b/src/Development/Bake/Format.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Format.hs
@@ -0,0 +1,39 @@
+
+module Development.Bake.Format(
+    tag, tag_,
+    table,
+    commas, commasLimit, unwordsLimit
+    ) where
+
+import Data.List.Extra
+
+
+table :: String -> [String] -> [[String]] -> [String]
+table zero cols [] = ["<p>" ++ zero ++ "</p>"]
+table _ cols body =
+    ["<table>"
+    ,tag_ "thead" $ tag_ "tr" $ concatMap (tag_ "td") cols
+    ,"<tbody>"] ++
+    [tag_ "tr" $ concatMap (tag_ "td") x | x <- body] ++
+    ["</tbody>"
+    ,"</table>"]
+
+
+tag_ :: String -> String -> String
+tag_ t = tag t []
+
+tag :: String -> [String] -> String -> String
+tag t at x = "<" ++ t ++ concatMap f at ++ ">" ++ x ++ "</" ++ t ++ ">"
+    where f x = let (a,b) = break (== '=') x in ' ':a ++ (if null b then "" else "=\"" ++ drop1 b ++ "\"")
+
+
+commas :: [String] -> String
+commas = intercalate ", "
+
+commasLimit :: Int -> [String] -> String
+commasLimit i xs = intercalate ", " a ++ (if null b then "" else "...")
+    where (a,b) = splitAt i xs
+
+unwordsLimit :: Int -> [String] -> String
+unwordsLimit i xs = unwords a ++ (if null b then "" else "...")
+    where (a,b) = splitAt i xs
diff --git a/src/Development/Bake/Git.hs b/src/Development/Bake/Git.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Git.hs
@@ -0,0 +1,65 @@
+
+module Development.Bake.Git(SHA1, ovenGit) where
+
+import Development.Bake.Type
+import Development.Shake.Command
+import Control.Monad.Extra
+import Data.List.Extra
+import Development.Bake.Format
+
+
+newtype SHA1 = SHA1 {fromSHA1 :: String} deriving (Show,Eq)
+
+sha1 :: String -> SHA1
+sha1 x | length x /= 40 = error $ "SHA1 for Git must be 40 characters long, got " ++ show x
+       | not $ all (`elem` "0123456789abcdef") x = error $ "SHA1 for Git must be all lower case hex, got " ++ show x 
+       | otherwise = SHA1 x
+
+stringySHA1 :: Stringy SHA1
+stringySHA1 = Stringy
+    {stringyTo = \(SHA1 x) -> x
+    ,stringyFrom = sha1
+    ,stringyPretty = \(SHA1 x) -> take 7 x
+    }
+
+
+-- | Modify an 'Oven' to work with the Git version control system.
+--   Requires the name of the repo (e.g. @https:\/\/github.com\/ndmitchell\/bake.git@)
+--   and the name of a branch (e.g. @master@).
+ovenGit :: String -> String -> Oven () () test -> Oven SHA1 SHA1 test
+ovenGit repo branch o = o
+    {ovenUpdateState = gitUpdateState
+    ,ovenPrepare = \s ps -> do gitCheckout s ps; ovenPrepare o () $ map (const ()) ps
+    ,ovenPatchExtra = gitPatchExtra
+    ,ovenStringyState = stringySHA1
+    ,ovenStringyPatch = stringySHA1
+    }
+    where
+        gitUpdateState Nothing = do
+            Stdout hash <- cmd "git ls-remote" repo ("refs/heads/" ++ branch)
+            case words hash of
+                [] -> error "Couldn't find branch"
+                x:xs -> return $ sha1 $ strip x
+
+        gitUpdateState (Just (s, ps)) = do
+            gitCheckout s ps
+            Stdout x <- cmd "git rev-parse HEAD"
+            unit $ cmd "git checkout -b temp"
+            unit $ cmd "git checkout -B master temp"
+            unit $ cmd "git push origin master --force"
+            return $ sha1 $ strip x
+
+        gitCheckout s ps = do
+            unit $ cmd "git clone" repo "."
+            unit $ cmd "git config user.email" ["https://github.com/ndmitchell/bake"]
+            unit $ cmd "git config user.name" ["Bake Continuous Integration"]
+            unit $ cmd "git checkout" (fromSHA1 s)
+            forM_ ps $ \p ->
+                unit $ cmd "git merge" (fromSHA1 p)
+
+        gitPatchExtra p = do
+            unit $ cmd "git clone" repo "."
+            Stdout full <- cmd "git diff" ("origin/" ++ branch ++ ".." ++ fromSHA1 p)
+            Stdout numstat <- cmd "git diff --numstat" ("origin/" ++ branch ++ ".." ++ fromSHA1 p)
+            let xs = [x | [_,_,x] <- map words $ lines numstat]
+            return (unwordsLimit 3 xs, tag_ "pre" full)
diff --git a/src/Development/Bake/Message.hs b/src/Development/Bake/Message.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Message.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
+
+module Development.Bake.Message(
+    Message(..), Ping(..), Question(..), Answer(..),
+    sendMessage, messageFromInput, questionToOutput
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Web
+import Control.Applicative
+import Control.Monad
+import Data.Aeson hiding (Success)
+import qualified Data.ByteString.Lazy.Char8 as LBS
+
+
+data Message
+    -- Send by the user
+    = AddPatch Author Patch
+    | DelPatch Author Patch
+    | DelAllPatches Author
+    | Pause Author
+    | Unpause Author
+    -- Sent by the client
+    | Pinged Ping
+    | Finished {question :: Question, answer :: Answer}
+    deriving (Show,Eq)
+
+data Question = Question
+    {qCandidate :: (State, [Patch])
+    ,qTest :: Maybe Test
+    ,qThreads :: Int
+    ,qClient :: Client
+    }
+    deriving (Show,Eq)
+
+data Answer = Answer
+    {aStdout :: String
+    ,aDuration :: Double
+    ,aTests :: ([Test],[Test])
+        -- only filled in if qTest is Nothing
+        -- (those tests which are suitable, those which are unsuitable)
+    ,aSuccess :: Bool
+    }
+    deriving (Show,Eq)
+
+data Ping = Ping
+    {pClient :: Client
+    ,pAuthor :: Author
+    ,pMaxThreads :: Int
+    ,pNowThreads :: Int
+    }
+    deriving (Show,Eq)
+
+
+-- JSON instance is only true for Finished
+instance ToJSON Message where
+    toJSON (Finished q a) = object ["question" .= q, "answer" .= a]
+
+instance FromJSON Message where
+    parseJSON (Object v) = Finished <$>
+        (v .: "question") <*> (v .: "answer")
+    parseJSON _ = mzero
+
+instance ToJSON Question where
+    toJSON Question{..} = object
+        ["candidate" .= toJSONCandidate qCandidate
+        ,"test" .= qTest
+        ,"threads" .= qThreads
+        ,"client" .= qClient]
+
+instance FromJSON Question where
+    parseJSON (Object v) = Question <$>
+        (fromJSONCandidate =<< (v .: "candidate")) <*> (v .: "test") <*> (v .: "threads") <*> (v .: "client")
+    parseJSON _ = mzero
+
+toJSONCandidate (s, ps) = object ["state" .= s, "patches" .= ps]
+
+fromJSONCandidate (Object v) = (,) <$> (v .: "state") <*> (v .: "patches")
+fromJSONCandidate _ = mzero
+
+instance ToJSON Answer where
+    toJSON Answer{..} = object
+        ["stdout" .= aStdout
+        ,"duration" .= aDuration
+        ,"tests" .= aTests
+        ,"success" .= aSuccess]
+
+instance FromJSON Answer where
+    parseJSON (Object v) = Answer <$>
+        (v .: "stdout") <*> (v .: "duration") <*> (v .: "tests") <*> (v .: "success")
+    parseJSON _ = mzero
+
+
+messageToInput :: Message -> Input
+messageToInput (AddPatch author (Patch patch)) = Input ["api","add"] [("author",author),("patch",patch)] ""
+messageToInput (DelPatch author (Patch patch)) = Input ["api","del"] [("author",author),("patch",patch)] ""
+messageToInput (DelAllPatches author) = Input ["api","delall"] [("author",author)] ""
+messageToInput (Pause author) = Input ["api","pause"] [("author",author)] ""
+messageToInput (Unpause author) = Input ["api","unpause"] [("author",author)] ""
+messageToInput (Pinged Ping{..}) = Input ["api","ping"]
+    [("client",fromClient pClient),("author",pAuthor)
+    ,("maxthreads",show pMaxThreads),("nowthreads",show pNowThreads)] ""
+messageToInput x@Finished{} = Input ["api","finish"] [] $ LBS.unpack $ encode x
+
+
+-- return either an error message (not a valid message), or a message
+messageFromInput :: Input -> Either String Message
+messageFromInput (Input [msg] args body)
+    | msg == "add" = AddPatch <$> str "author" <*> (Patch <$> str "patch")
+    | msg == "del" = DelPatch <$> str "author" <*> (Patch <$> str "patch")
+    | msg == "delall" = DelAllPatches <$> str "author"
+    | msg == "pause" = Pause <$> str "author"
+    | msg == "ping" = Pinged <$> (Ping <$> (Client <$> str "client") <*>
+        str "author" <*> int "maxthreads" <*> int "nowthreads")
+    | msg == "finish" = eitherDecode $ LBS.pack body
+    where str x | Just v <- lookup x args = Right v
+                | otherwise = Left $ "Missing field " ++ show x ++ " from " ++ show msg
+          int x = read <$> str x
+messageFromInput (Input msg args body) = Left $ "Invalid API call, got " ++ show msg
+
+
+questionToOutput :: Maybe Question -> Output
+questionToOutput = OutputString . LBS.unpack . encode
+
+
+sendMessage :: (Host,Port) -> Message -> IO (Maybe Question)
+sendMessage hp msg = do
+    res <- send hp $ messageToInput msg
+    return $ decode $ LBS.pack res
diff --git a/src/Development/Bake/Send.hs b/src/Development/Bake/Send.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Send.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Development.Bake.Send(
+    sendPause, sendUnpause,
+    sendAddPatch, sendDelPatch, sendDelAllPatches
+    ) where
+
+import Control.Monad
+import Development.Bake.Type
+import Development.Bake.Message
+
+sendPause :: (Host,Port) -> Author -> IO ()
+sendPause hp author = void $ sendMessage hp $ Pause author
+
+sendUnpause :: (Host,Port) -> Author -> IO ()
+sendUnpause hp author = void $ sendMessage hp $ Unpause author
+
+sendAddPatch :: (Host,Port) -> Author -> String -> IO ()
+sendAddPatch hp author x = void $ sendMessage hp $ AddPatch author $ Patch x
+
+sendDelPatch :: (Host,Port) -> Author -> String -> IO ()
+sendDelPatch hp author x = void $ sendMessage hp $ DelPatch author $ Patch x
+
+sendDelAllPatches :: (Host,Port) -> Author -> IO ()
+sendDelAllPatches hp author = void $ sendMessage hp $ DelAllPatches author
diff --git a/src/Development/Bake/Server/Brains.hs b/src/Development/Bake/Server/Brains.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Server/Brains.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE RecordWildCards, TupleSections, ViewPatterns #-}
+
+module Development.Bake.Server.Brains(
+    brains, Neuron(..)
+    ) where
+
+import Development.Bake.Message
+import Development.Bake.Type
+import Development.Bake.Server.Type
+import Data.Maybe
+import Control.Monad
+import Data.List.Extra
+
+
+data Neuron
+    = Sleep -- nothing useful to do
+    | Task Question
+    | Update -- update to the active state
+    | Reject Patch (Maybe Test) -- reject this patch
+    | Broken (Maybe Test) -- the active state with zero patches has ended up broken
+      deriving Show
+
+-- Given a ping from a client, figure out what work we can get them to do, if anything
+brains :: (Test -> [Test]) -> Server -> Ping -> Neuron
+brains _ Server{active=(_, [])} _ = Sleep -- no outstanding tasks
+
+brains depends Server{..} Ping{..}
+    | allTestsPass active = Update
+    | t:_ <- minimumRelation dependsMay $ failingTests active = erroneous t active
+    | otherwise = let next = filter (suitableTest active) $ allTests active
+                  in taskMay active $ listToMaybe next
+    where
+        taskMay c t = maybe Sleep (\t -> Task $ Question c t 1 pClient) t
+        dependsMay Nothing = []
+        dependsMay (Just t) = Nothing : map Just (depends t)
+
+        erroneous t (s, o@(unsnoc -> Just (ps,p))) =
+            case (stateTest (s, o) t, stateTest (s, ps) t) of
+                (Just True, _) -> error "logical inconsistentcy in brains, expected erroneous test"
+                (Just False, Just True) -> Reject p t
+                (Just False, Just False) -> erroneous t (s,ps)
+                (Nothing, _) -> taskMay (s, o ) $ scheduleTest (s, o ) t
+                (_, Nothing) -> taskMay (s, ps) $ scheduleTest (s, ps) t
+        erroneous t (s, []) = Broken t
+
+        -- all the tests we know about for this candidate, may be incomplete if Nothing has not passed (yet)
+        allTests c = (Nothing:) $ map Just $ concat $ take 1 $
+            map (uncurry (++) . aTests . snd) $ success' $ test' Nothing $ answered' $ candidate' c it
+
+        -- are all tests passing for this candidate
+        allTestsPass c = flip all (allTests c) $ \t ->
+            not $ null $ success' $ test' t $ answered' $ candidate' c it
+
+        -- what tests are failing for this candidate
+        failingTests c = map (qTest . fst) $ failure' $ answered' $ candidate' c it
+
+        -- can this candidate start running this test
+        suitableTest c t
+            | pNowThreads <= 0 = False -- need enough threads
+        suitableTest c Nothing
+            | null $ self' $ test' Nothing $ candidate' c it -- I am not already running it
+            = True
+        suitableTest c t@(Just tt)
+            | [clientTests] <- map (fst . aTests . snd) $ self' $ success' $ test' Nothing $ answered' $ candidate' c it
+            , tt `elem` clientTests -- it is one of the tests this client is suitable for
+            , null $ test' t $ self' $ candidate' c it -- I am not running it or have run it
+            , clientDone <- map (qTest . fst) $ success' $ answered' $ self' $ candidate' c it
+            , all (`elem` clientDone) $ map Just $ depends tt
+            = True
+        suitableTest _ _ = False
+
+        -- what is the state of this candidate/test, either Just v (aSuccess) or Nothing (not tried)
+        stateTest c t = fmap aSuccess $ join $ fmap snd $ listToMaybe $ test' t $ candidate' c it
+
+        -- given that I want to run this particular test, what test should I do next
+        -- must pass suitableTest
+        scheduleTest c Nothing =
+            if suitableTest c Nothing then Just Nothing else Nothing
+        scheduleTest c t@(Just tt)
+            | [clientTests] <- map (fst . aTests . snd) $ self' $ success' $ test' Nothing $ answered' $ candidate' c it
+            , tt `elem` clientTests -- the target is one of the tests this client is suitable for
+            = listToMaybe $ filter (suitableTest c) $ transitiveClosure dependsMay t
+        scheduleTest c t@(Just tt)
+            | null $ self' $ test' Nothing $ candidate' c it -- have never prepared on this client
+            = Just Nothing
+        scheduleTest _ _ = Nothing
+
+        -- query language
+        it = [(q,a) | (_,q,a) <- history]
+        candidate' c = filter ((==) c . qCandidate . fst)
+        test' t = filter ((==) t . qTest . fst) 
+        self' = filter ((==) pClient . qClient . fst) 
+        success' = filter (aSuccess . snd)
+        failure' = filter (not . aSuccess . snd)
+        answered' x = [(q,a) | (q,Just a) <- x]
+
+{-
+brains depends Server{..} Ping{..}
+    | null failingTests && setupStep == Nothing = (Just $ Question active Nothing 1 pClient, Nothing, False)
+    | null failingTests && setupStep == Just Nothing = (Nothing, Nothing, False)
+    | null failingTests && null testsTodo = (Nothing, Nothing, True)
+    | null failingTests = (fmap (\t -> Question active (Just t) 1 pClient) $ listToMaybe $ filter suitableTest testsTodo, Nothing, False)
+    | otherwise = case dropWhile ((== Just False) . snd) $ reverse failingOn of
+        [] -> (Nothing, Just $ head patches, False)
+        (_,Just True):rest -> (Nothing, Just $ patches !! (length rest + 1), False)
+        (ps,Nothing):_ -> error $ "brains, need to attempt with " ++ show ps
+    where
+        -- history for those who match the active candidate
+        historyActive = filter ((==) active . qCandidate . snd3) history
+
+        -- tests that have failed for the current candidate
+        failingTests = [qTest | (_,Question{..},Just Answer{aSuccess=False}) <- historyActive]
+
+        -- Nothing = never run, Just Nothing = in progress, Just (Just t) = completed
+        setupStep = listToMaybe [fmap aTests a
+            | (_,Question{qTest=Nothing,..},a) <- historyActive, qClient == pClient]
+
+        testsDone = [t | (_,Question{qTest=Just t},Just Answer{aSuccess=True}) <- historyActive]
+        testsNeed = let (a,b) = fromJust (fromJust setupStep) in a ++ b
+        testsTodo = testsDone \\ testsNeed
+        testsDoneMe = [t | (_,Question{qTest=Just t,..},Just Answer{aSuccess=True}) <- historyActive, qClient == pClient]
+
+        -- a test is suitable to run if:
+        -- 1) there are enough threads outstanding
+        -- 2) this client is capable of running the test
+        -- 3) it's dependencies have all been run by this client
+        suitableTest t =
+            pNowThreads >= 1 &&
+            t `elem` fst (fromJust $ fromJust setupStep) &&
+            all (`elem` testsDoneMe) (depends t)
+
+        Candidate state patches = active
+
+        -- for each patch in the candidate state, does the first failing test fail or not (or unknown)
+        failingOn = [ (p,) $ listToMaybe [aSuccess | (_,Question{..},Just Answer{..}) <- history, qCandidate == Candidate state p, qTest == head failingTests]
+                    | p <- tail $ inits patches]
+-}
+
+
+transitiveClosure :: Eq a => (a -> [a]) -> a -> [a]
+transitiveClosure f = nub . g
+    where g x = x : concatMap g (f x)
+
+minimumRelation :: Eq a => (a -> [a]) -> [a] -> [a]
+minimumRelation f (x:xs) = [x | disjoint (transitiveClosure f x) xs] ++ minimumRelation f xs
+minimumRelation f [] = []
diff --git a/src/Development/Bake/Server/Start.hs b/src/Development/Bake/Server/Start.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Server/Start.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE RecordWildCards, TupleSections, ViewPatterns #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Server.Start(
+    startServer
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Web
+import Development.Bake.Message
+import Development.Bake.Server.Type
+import Development.Bake.Server.Web
+import Development.Bake.Server.Brains
+import Control.Concurrent
+import Control.DeepSeq
+import Control.Arrow
+import Control.Exception.Extra
+import Data.List.Extra
+import Data.Maybe
+import Data.Time.Clock
+import Control.Monad.Extra
+import Data.Tuple.Extra
+import System.Directory.Extra
+import System.IO.Extra
+import System.Console.CmdArgs.Verbosity
+
+
+startServer :: Port -> Author -> String -> Double -> Oven state patch test -> IO ()
+startServer port author name timeout (concrete -> oven) = do
+    curdirLock <- newMVar ()
+    s <- withTempDirCurrent curdirLock $ ovenUpdateState oven Nothing
+    putStrLn $ "Initial state of: " ++ show s
+    var <- newMVar $ (defaultServer s){authors = [(Nothing,author)]}
+    server port $ \i@Input{..} -> do
+        whenLoud $ print i
+        handle_ (fmap OutputError . showException) $ do
+            res <-
+                if null inputURL || ["ui"] `isPrefixOf` inputURL then
+                    web oven i{inputURL = drop 1 inputURL} =<< readMVar var
+                else if ["api"] `isPrefixOf` inputURL then
+                    (case messageFromInput i{inputURL = drop 1 inputURL} of
+                        Left e -> return $ OutputError e
+                        Right v -> do
+                            fmap questionToOutput $ modifyMVar var $ \s -> do
+                                (s,q) <- operate curdirLock timeout oven v s
+                                case v of
+                                    AddPatch _ p | p `notElem` map fst (extra s) -> do
+                                        forkIO $ do
+                                            res <- try_ $ withTempDirCurrent curdirLock $
+                                                evaluate . force =<< ovenPatchExtra oven p
+                                            res <- either (fmap dupe . showException) return res
+                                            modifyMVar_ var $ \s -> return s{extra = (p,res) : extra s}
+                                        return (s{extra=(p,("","")):extra s}, q)
+                                    _ -> return (s,q)
+                    )
+                else
+                    return OutputMissing
+            evaluate $ force res
+
+
+operate :: MVar () -> Double -> Oven State Patch Test -> Message -> Server -> IO (Server, Maybe Question)
+operate curdirLock timeout oven message server = case message of
+    AddPatch author p | (s, ps) <- active server -> do
+        whenLoud $ print ("Add patch to",s,snoc ps p)
+        now <- getCurrentTime
+        dull server{active = (s, snoc ps p), authors = (Just p, author) : authors server, submitted = (now,p) : submitted server}
+    DelPatch author p | (s, ps) <- active server -> dull server{active = (s, delete p ps)}
+    Pause author -> dull server{paused = Just $ fromMaybe [] $ paused server}
+    Unpause author | (s, ps) <- active server ->
+        dull server{paused=Nothing, active = (s, ps ++ maybe [] (map snd) (paused server))}
+    Finished q a -> do
+        whenLoud $ when (not $ aSuccess a) $ print ("Test failed",qCandidate q == active server,q,a)
+        server <- return server{history = [(t,qq,if q == qq then Just a else aa) | (t,qq,aa) <- history server]}
+        consistent server
+        dull server 
+    Pinged ping -> do
+        now <- getCurrentTime
+        server <- return $ prune (addUTCTime (fromRational $ toRational $ negate timeout) now) $ server
+            {pings = (now,ping) : filter ((/= pClient ping) . pClient . snd) (pings server)}
+        let depends = testRequire . ovenTestInfo oven
+        flip loopM server $ \server ->
+            case brains depends server ping of
+                Sleep ->
+                    return $ Right (server, Nothing)
+                Task q -> do
+                    when (qClient q /= pClient ping) $ error "client doesn't match the ping"
+                    server <- return $ server{history = (now,q,Nothing) : history server}
+                    return $ Right (server, Just q)
+                Update -> do
+                    s <- withTempDirCurrent curdirLock $ ovenUpdateState oven $ Just $ active server
+                    ovenNotify oven [a | (p,a) <- authors server, maybe False (`elem` snd (active server)) p] $ unlines
+                        ["Your patch just made it in"]
+                    return $ Left server{active=(s, []), updates=(now,s,active server):updates server}
+                Reject p t -> do
+                    ovenNotify oven [a | (pp,a) <- authors server, Just p == pp] $ unlines
+                        ["Your patch " ++ show p ++ " got rejected","Failure in test " ++ show t]
+                    return $ Left server{active=second (delete p) $ active server}
+                Broken t -> do
+                    ovenNotify oven [a | (p,a) <- authors server, maybe True (`elem` snd (active server)) p] $ unlines
+                        ["Eek, it's all gone horribly wrong","Failure with no patches in test " ++ show t]
+                    return $ Left server{active=(fst $ active server, [])}
+    where
+        dull s = return (s,Nothing)
+
+
+-- any question that has been asked of a client who hasn't pinged since the time is thrown away
+prune :: UTCTime -> Server -> Server
+prune cutoff s = s{history = filter (flip elem clients . qClient . snd3) $ history s}
+    where clients = [pClient | (t,Ping{..}) <- pings s, t >= cutoff]
+
+consistent :: Server -> IO ()
+consistent Server{..} = do
+    let xs = groupSort $ map (qCandidate . snd3 &&& id) $ filter (isNothing . qTest . snd3) history
+    forM_ xs $ \(c,vs) -> do
+        case nub $ map (sort . uncurry (++) . aTests) $ filter aSuccess $ mapMaybe thd3 vs of
+            a:b:_ -> error $ "Tests don't match for candidate: " ++ show (c,a,b,vs)
+            _ -> return ()
+
+
+withTempDirCurrent :: MVar () -> IO a -> IO a
+withTempDirCurrent curdirLock act = withMVar curdirLock $ const $ withTempDir $ \t -> withCurrentDirectory t act
diff --git a/src/Development/Bake/Server/Type.hs b/src/Development/Bake/Server/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Server/Type.hs
@@ -0,0 +1,34 @@
+
+-- | Define a continuous integration system.
+module Development.Bake.Server.Type(
+    Server(..), defaultServer,
+    Question(..), Answer(..), Ping(..)
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Message
+import Data.Time.Clock
+
+
+defaultServer :: State -> Server
+defaultServer s = Server [] [] [] (s,[]) Nothing [] [] []
+
+data Server = Server
+    {history :: [(UTCTime, Question, Maybe Answer)]
+        -- ^ Questions you have sent to clients, and how they responded (if they have).
+        --   The aStdout has been written to disk, and the value is a filename containing the stdout.
+    ,updates :: [(UTCTime, State, (State, [Patch]))]
+        -- ^ Updates that have been made
+    ,pings :: [(UTCTime, Ping)]
+        -- ^ Latest time of a ping sent by each client
+    ,active :: (State, [Patch])
+        -- ^ The candidate we are currently aiming to prove
+    ,paused :: Maybe [(UTCTime, Patch)]
+        -- ^ 'Just' if we are paused, and the number of people queued up
+    ,submitted :: [(UTCTime, Patch)]
+        -- ^ List of all patches that have been submitted over time
+    ,authors :: [(Maybe Patch, Author)]
+        -- ^ Authors associated with each patch (Nothing is the server author)
+    ,extra :: [(Patch, (String, String))]
+        -- ^ Extra information that was computed for each string (cached forever)
+    } deriving Show
diff --git a/src/Development/Bake/Server/Web.hs b/src/Development/Bake/Server/Web.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Server/Web.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Server.Web(
+    web
+    ) where
+
+import Development.Bake.Server.Type
+import Development.Bake.Type
+import Development.Bake.Web
+import Development.Bake.Format
+import Data.List.Extra
+import Data.Time.Clock
+import Data.Tuple.Extra
+
+
+web :: Oven State Patch Test -> Input -> Server -> IO Output
+web Oven{..} Input{..} server = return $ OutputHTML $ unlines $
+    prefix ++
+    (case () of
+        _ | Just c <- lookup "client" inputArgs ->
+                ["<h2>Runs on " ++ c ++ "</h2>"] ++
+                runs shower (nostdout server) ((==) (Client c) . qClient)
+          | Just t <- lookup "test" inputArgs, Just p <- lookup "patch" inputArgs ->
+                let tt = if t == "" then Nothing else Just $ Test t in
+                runs shower server (\Question{..} -> Patch p `elem` snd qCandidate && qTest == tt)
+          | Just p <- lookup "patch" inputArgs ->
+                runs shower (nostdout server) (elem (Patch p) . snd . qCandidate) ++
+                ["<h2>Patch information</h2>"] ++
+                [e | (pp,(_,e)) <- extra server, Patch p == pp]
+          | otherwise ->
+                ["<h2>Patches</h2>"] ++
+                table "No patches submitted" ["Patch","Status"] (map (patch shower server) patches) ++
+                ["<h2>Clients</h2>"] ++
+                table "No clients available" ["Name","Running"] (map (client shower server) clients)
+    ) ++
+    suffix
+    where
+        patches = submitted server
+        clients = sort $ nub $ map (pClient . snd) $ pings server
+        shower = Shower
+            {showPatch = \p -> tag "a" ["href=?patch=" ++ fromPatch p, "class=patch"] (stringyPretty ovenStringyPatch p)
+            ,showTest = \p t -> tag "a" ["href=?patch=" ++ fromPatch p ++ "&" ++ "test=" ++ maybe "" fromTest t] $
+                                maybe "Preparing" (stringyPretty ovenStringyTest) t
+            }
+
+data Shower = Shower
+    {showPatch :: Patch -> String
+    ,showTest :: Patch -> Maybe Test -> String
+    }
+
+
+prefix =
+    ["<!HTML>"
+    ,"<html>"
+    ,"<head>"
+    ,"<title>Bake Continuous Integration</title>"
+    ,"<style type='text/css'>"
+    ,"body, td {font-family: sans-serif; font-size: 10pt;}"
+    ,"table {border-collapse: collapse;}"
+    ,"table, td {border: 1px solid #ccc;}"
+    ,"td {padding: 2px; padding-right: 15px;}"
+    ,"thead {font-weight: bold;}"
+    ,"a {text-decoration: none; color: #4183c4;}"
+    ,"a:hover {text-decoration: underline;}"
+    ,".patch {font-family: Consolas, monospace;}"
+    ,".info {font-size: 75%; color: #888;}"
+    ,"a.info {color: #4183c4;}" -- tie breaker
+    ,".good {font-weight: bold; color: #480}"
+    ,".bad {font-weight: bold; color: #800}"
+    ,"#footer {margin-top: 40px; font-size: 80%;}"
+    ,"</style>"
+    ,"</head>"
+    ,"<body>"
+    ,"<h1>Bake Continuous Integration</h1>"
+    ]
+
+suffix =
+    ["<p id=footer><a href='https://github.com/ndmitchell/bake'>Copyright Neil Mitchell 2014</a></p>"
+    ,"</body>"
+    ,"</html>"]
+
+nostdout :: Server -> Server
+nostdout s = s{history = [(t,q,fmap (\a -> a{aStdout=""}) a) | (t,q,a) <- history s]}
+
+runs :: Shower -> Server -> (Question -> Bool) -> [String]
+runs Shower{..} Server{..} pred = table "No runs" ["Time","Question","Answer"]
+    [[show t, show q, show a] | (t,q,a) <- history, pred q]
+
+patch :: Shower -> Server -> (UTCTime, Patch) -> [String]
+patch Shower{..} Server{..} (u, p) =
+    [showPatch p ++ " by " ++ commasLimit 3 [a | (pp,a) <- authors, Just p == pp] ++ "<br />" ++
+     tag "span" ["class=info"] (maybe "" fst (lookup p extra))
+    ,if p `elem` concatMap (snd . thd3) updates then tag "span" ["class=good"] "Merged"
+     else if p `elem` snd active then
+        "Testing (passed " ++ show (length $ filter fst done) ++ " of " ++ (if todo == 0 then "?" else show todo) ++ ")<br />" ++
+        tag "span" ["class=info"]
+            (if any (not . fst) done then "Retrying " ++ commasLimit 3 [showTest p t | (False,t) <- done]
+             else if not $ null running then "Running " ++ commasLimit 3 (map (showTest p) running)
+             else "")
+     else if p `elem` maybe [] (map snd) paused then "Paused"
+     else tag "span" ["class=bad"] "Rejected" ++ "<br />" ++
+          tag "span" ["class=info"] (commasLimit 3 [showTest p t | (False,t) <- done, (True,t) `notElem` done])
+    ]
+    where
+        todo = length $ nub
+            [ t
+            | (_,Question{..},Just Answer{..}) <- history
+            , p `elem` snd qCandidate
+            , t <- uncurry (++) aTests]
+        done = nub
+            [ (aSuccess,qTest)
+            | (_,Question{..},Just Answer{..}) <- history
+            , p `elem` snd qCandidate]
+        running = nub
+            [ qTest
+            | (_,Question{..},Nothing) <- history
+            , p `elem` snd qCandidate]
+
+client :: Shower -> Server -> Client -> [String]
+client Shower{..} Server{..} c =
+    [tag "a" ["href=?client=" ++ fromClient c] $ fromClient c
+    ,if null active then "<i>None</i>"
+     else commas $ map (uncurry showTest) active]
+    where active = [(last $ Patch "" : snd qCandidate, qTest) | (_,Question{..},Nothing) <- history, qClient == c]
diff --git a/src/Development/Bake/Type.hs b/src/Development/Bake/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Type.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Type(
+    Host, Port,
+    Stringy(..), readShowStringy,
+    Oven(..), TestInfo(..), defaultOven, ovenTest, ovenNotifyStdout,
+    threads, threadsAll, require, run, suitable,
+    State(..), Patch(..), Test(..), Client(..), concrete,
+    Author
+    ) where
+
+import Development.Bake.Format
+import Control.Monad.Extra
+import Data.Monoid
+import Data.Aeson
+import Control.Arrow
+
+
+type Author = String
+
+type Host = String
+
+type Port = Int
+
+-- | The central type defining a continuous integration system.
+--   Usually constructed with 'defaultOven' then filled out with other
+--   'Oven' modifiers such as 'ovenGit' and 'ovenTest'.
+--
+--   The types are: @state@ is the base state of the system (think HEAD on the master branch);
+--   @patch@ is a change that is proposed (think a diff); @test@ is the type of tests that
+--   are run.
+data Oven state patch test = Oven
+    {ovenUpdateState :: Maybe (state, [patch]) -> IO state
+        -- ^ Given a state, and a set of candiates that have passed,
+        --   merge to create a new state.
+    ,ovenPrepare :: state -> [patch] -> IO [test]
+        -- ^ Prepare a candidate to be run, produces the tests that must pass
+    ,ovenTestInfo :: test -> TestInfo test
+        -- ^ Produce information about a test
+    ,ovenNotify :: [Author] -> String -> IO ()
+        -- ^ Tell an author some information contained in the string (usually an email)
+    ,ovenPatchExtra :: patch -> IO (String, String)
+        -- ^ Extra information about a patch, a single line (HTML span),
+        --   and a longer chunk (HTML block)
+    ,ovenServer :: (Host, Port)
+        -- ^ Default server to use
+    ,ovenStringyState :: Stringy state
+    ,ovenStringyPatch :: Stringy patch
+    ,ovenStringyTest :: Stringy test
+    }
+
+-- | Given a 'Stringy' for @test@, and a function that when run on a code base
+--   returns the list of tests that need running, and a function to populate
+--   a 'TestInfo', modify the 'Oven' with a test type.
+ovenTest :: Stringy test -> IO [test] -> (test -> TestInfo test)
+         -> Oven state patch () -> Oven state patch test
+ovenTest stringy prepare info o = o{ovenStringyTest=stringy, ovenPrepare= \_ _ -> prepare, ovenTestInfo=info}
+
+-- | Produce notifications on 'stdout' when users should be notified about success/failure.
+ovenNotifyStdout :: Oven state patch test -> Oven state patch test
+ovenNotifyStdout o = o{ovenNotify = \a s -> f a s >> ovenNotify o a s}
+    where f a s = putStr $ unlines
+                    [replicate 70 '-'
+                    ,"To: " ++ commas a
+                    ,s
+                    ,replicate 70 '-'
+                    ]
+
+-- | A type representing a translation between a value and a string, which can be
+--   produced by 'readShowStringy' if the type has both 'Read' and 'Show' instances.
+--   The functions 'stringyTo' and 'stringyFrom' should be inverses of each other.
+--   The function 'stringyPretty' shows a value in a way suitable for humans, and can
+--   discard uninteresting information.
+data Stringy s = Stringy
+    {stringyTo :: s -> String
+    ,stringyFrom :: String -> s
+    ,stringyPretty :: s -> String
+    }
+
+-- | Produce a 'Stringy' for a type with 'Read' and 'Show'.
+readShowStringy :: (Show s, Read s) => Stringy s
+readShowStringy = Stringy show read show
+
+-- | The default oven, which doesn't do anything interesting. Usually the starting point.
+defaultOven :: Oven () () ()
+defaultOven = Oven
+    {ovenUpdateState = \_ -> return ()
+    ,ovenNotify = \_ _ -> return ()
+    ,ovenPrepare = \_ _ -> return []
+    ,ovenTestInfo = \_ -> mempty
+    ,ovenPatchExtra = \_ -> return ("","")
+    ,ovenServer = ("127.0.0.1",80)
+    ,ovenStringyState = readShowStringy
+    ,ovenStringyPatch = readShowStringy
+    ,ovenStringyTest = readShowStringy
+    }
+
+-- | Information about a test.
+data TestInfo test = TestInfo
+    {testThreads :: Maybe Int -- number of threads, defaults to 1, Nothing for use all
+    ,testAction :: IO ()
+    ,testSuitable :: IO Bool -- can this test be run on this machine (e.g. Linux only tests)
+    ,testRequire :: [test]
+    }
+
+instance Functor TestInfo where
+    fmap f t = t{testRequire = map f $ testRequire t}
+
+instance Monoid (TestInfo test) where
+    mempty = TestInfo (Just 1) (return ()) (return True) []
+    mappend (TestInfo x1 x2 x3 x4) (TestInfo y1 y2 y3 y4) =
+        TestInfo (liftM2 (+) x1 y1) (x2 >> y2) (x3 &&^ y3) (x4 ++ y4)
+
+-- | Change the number of threads a test requires, defaults to 1.
+threads :: Int -> TestInfo test -> TestInfo test
+threads j t = t{testThreads=Just j}
+
+-- | Record that a test requires all available threads on a machine,
+--   typically used for the build step.
+threadsAll :: TestInfo test -> TestInfo test
+threadsAll t = t{testThreads=Nothing}
+
+-- | Require the following tests have been evaluated on this machine
+--   before this test is run. Typically used to require compilation
+--   before running most tests.
+require :: [test] -> TestInfo test -> TestInfo test
+require xs t = t{testRequire=testRequire t++xs}
+
+-- | The action associated with a @test@.
+run :: IO () -> TestInfo test
+run act = mempty{testAction=act}
+
+-- | Is a particular client capable of running a test.
+--   Usually an OS check.
+suitable :: IO Bool -> TestInfo test -> TestInfo test
+suitable query t = t{testSuitable = query &&^ testSuitable t}
+
+
+newtype State = State {fromState :: String} deriving (Show,Eq,Ord,ToJSON,FromJSON)
+newtype Patch = Patch {fromPatch :: String} deriving (Show,Eq,Ord,ToJSON,FromJSON)
+newtype Test = Test {fromTest :: String} deriving (Show,Eq,Ord,ToJSON,FromJSON)
+newtype Client = Client {fromClient :: String} deriving (Show,Eq,Ord,ToJSON,FromJSON)
+
+concrete :: Oven state patch test -> Oven State Patch Test
+concrete o@Oven{..} = o
+    {ovenUpdateState = fmap restate . ovenUpdateState . fmap (unstate *** map unpatch)
+    ,ovenPrepare = \s ps -> fmap (map retest) $ ovenPrepare (unstate s) (map unpatch ps)
+    ,ovenTestInfo = fmap retest . ovenTestInfo . untest
+    ,ovenPatchExtra = ovenPatchExtra . unpatch
+    ,ovenStringyState = state
+    ,ovenStringyPatch = patch
+    ,ovenStringyTest  = test
+    }
+    where
+        (patch,unpatch,_      ) = f Patch fromPatch ovenStringyPatch
+        (state,unstate,restate) = f State fromState ovenStringyState
+        (test ,untest ,retest ) = f Test  fromTest  ovenStringyTest
+
+        f :: (String -> s) -> (s -> String) -> Stringy o -> (Stringy s, s -> o, o -> s)
+        f inj proj Stringy{..} =
+            (Stringy proj inj (stringyPretty . stringyFrom . proj)
+            ,stringyFrom . proj
+            ,inj . stringyTo)
diff --git a/src/Development/Bake/Web.hs b/src/Development/Bake/Web.hs
new file mode 100644
--- /dev/null
+++ b/src/Development/Bake/Web.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE ScopedTypeVariables, RecordWildCards, OverloadedStrings #-}
+
+module Development.Bake.Web(
+    Input(..), Output(..), send, server
+    ) where
+
+import Development.Bake.Type hiding (run)
+import Network.Wai.Handler.Warp hiding (Port)
+import Network.Wai
+import Control.DeepSeq
+import Control.Exception
+import Network.HTTP.Types.Status
+import Network.HTTP hiding (Request)
+import qualified Data.Text as Text
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import System.Console.CmdArgs.Verbosity
+
+
+data Input = Input
+    {inputURL :: [String]
+    ,inputArgs :: [(String, String)]
+    ,inputBody :: String
+    } deriving Show
+
+data Output
+    = OutputString String
+    | OutputHTML String
+    | OutputFile FilePath
+    | OutputError String
+    | OutputMissing
+      deriving Show
+
+instance NFData Output where
+    rnf (OutputString x) = rnf x
+    rnf (OutputHTML x) = rnf x
+    rnf (OutputFile x) = rnf x
+    rnf (OutputError x) = rnf x
+    rnf OutputMissing = ()
+
+
+send :: (Host,Port) -> Input -> IO String
+send (host,port) Input{..} = do
+    let url = "http://" ++ host ++ ":" ++ show port ++ concatMap ('/':) inputURL ++
+              concat (zipWith (++) ("?":repeat "&") [a ++ "=" ++ b | (a,b) <- inputArgs])
+    whenLoud $ print ("sending",inputBody,host,port)
+    res <- simpleHTTP (getRequest url)
+        {rqBody=inputBody
+        ,rqHeaders=[Header HdrContentType "application/x-www-form-urlencoded", Header HdrContentLength $ show $ length inputBody]}
+    case res of
+        Left err -> error $ show err
+        Right r | rspCode r /= (2,0,0) -> error $
+                    "Incorrect code: " ++ show (rspCode r,rspReason r,url) ++ "\n" ++ rspBody r
+                | otherwise -> return $ rspBody r
+
+
+server :: Port -> (Input -> IO Output) -> IO ()
+server port act = runSettings (setOnException exception $ setPort port defaultSettings) $ \req reply -> do
+    bod <- strictRequestBody req
+    whenLoud $ print ("receiving",bod,requestHeaders req,port)
+    let pay = Input
+            (map Text.unpack $ pathInfo req)
+            [(BS.unpack a, maybe "" BS.unpack b) | (a,b) <- queryString req]
+            (LBS.unpack bod)
+    res <- act pay
+    reply $ case res of
+        OutputFile file -> responseFile status200 [] file Nothing
+        OutputString msg -> responseLBS status200 [] $ LBS.pack msg
+        OutputHTML msg -> responseLBS status200 [("content-type","text/html")] $ LBS.pack msg
+        OutputError msg -> responseLBS status500 [] $ LBS.pack msg
+        OutputMissing -> responseLBS status404 [] $ LBS.pack "Resource not found"
+
+exception :: Maybe Request -> SomeException -> IO ()
+exception r e
+    | Just (_ :: InvalidRequest) <- fromException e = return ()
+    | otherwise = putStrLn $ "Error when processing " ++ maybe "Nothing" (show . rawPathInfo) r ++
+                             "\n    " ++ show e
diff --git a/src/Example.hs b/src/Example.hs
new file mode 100644
--- /dev/null
+++ b/src/Example.hs
@@ -0,0 +1,43 @@
+
+module Example(main, platforms) where
+
+import Development.Bake
+import Development.Shake.Command
+import System.Environment
+import System.FilePath
+import Data.List.Extra
+import Control.Arrow
+import Data.Maybe
+
+
+data Platform = Linux | Windows deriving (Show,Read)
+data Action = Compile | Run Int deriving (Show,Read)
+
+platforms = [Linux,Windows]
+
+main :: IO ()
+main = do
+    let err = "You need to set an environment variable named $REPO for the Git repo"
+    repo <- fromMaybe (error err) `fmap` lookupEnv "REPO"
+    bake $
+        ovenGit repo "master" $
+        ovenNotifyStdout $
+        ovenTest testStringy (return allTests) execute
+        defaultOven{ovenServer=("127.0.0.1",5000)}
+
+testStringy = Stringy shw rd shw
+    where shw (a,b) = show a ++ " " ++ show b
+          rd x = (read *** read) $ word1 x
+
+allTests = [(p,t) | p <- platforms, t <- Compile : map Run [1,10,0]]
+
+execute :: (Platform,Action) -> TestInfo (Platform,Action)
+execute (p,Compile) = matchOS p $ run $ do
+    cmd "ghc --make Main.hs"
+execute (p,Run i) = require [(p,Compile)] $ matchOS p $ run $ do
+    cmd ("." </> "Main") (show i)
+
+-- So we can run both clients on one platform we use an environment variable
+-- to fake changing OS
+matchOS :: Platform -> TestInfo t -> TestInfo t
+matchOS p = suitable (fmap (== show p) $ getEnv "PLATFORM")
diff --git a/src/Test.hs b/src/Test.hs
new file mode 100644
--- /dev/null
+++ b/src/Test.hs
@@ -0,0 +1,127 @@
+
+module Test(main) where
+
+import Development.Shake.Command
+import System.Directory.Extra
+import System.IO.Extra
+import System.Time.Extra
+import System.Environment
+import System.FilePath
+import Control.Monad.Extra
+import Control.Exception
+import Control.Concurrent
+import System.Process
+import Data.IORef
+import Data.Char
+import qualified Example
+
+
+main :: IO ()
+main = do
+    args <- getArgs
+    if args /= [] then Example.main else do
+        dir <- getCurrentDirectory
+        test $ dir ++ "/.bake-test"
+
+test :: FilePath -> IO ()
+test dir = do
+    b <- doesDirectoryExist dir
+    when b $ do
+        () <- cmd "chmod -R 755 .bake-test"
+        () <- cmd "rm -rf .bake-test"
+        return ()
+
+    createDirectoryIfMissing True (dir </> "repo")
+    withCurrentDirectory (dir </> "repo") $ do
+        () <- cmd "git init"
+        () <- cmd "git config user.email" ["master@example.com"]
+        () <- cmd "git config user.name" ["The Master"]
+        writeFile "Main.hs" "module Main where\n\n-- Entry point\nmain = print 1\n"
+        () <- cmd "git add Main.hs"
+        () <- cmd "git commit -m" ["Initial version"]
+        () <- cmd "git checkout -b none" -- so I can git push to master
+        return ()
+
+    forM_ ["bob","tony"] $ \s -> do
+        createDirectoryIfMissing True (dir </> "repo-" ++ s)
+        withCurrentDirectory (dir </> "repo-" ++ s) $ do
+            print "clone"
+            () <- cmd "git clone ../repo ."
+            () <- cmd "git config user.email" [s ++ "@example.com"]
+            () <- cmd "git config user.name" ["Mr " ++ toUpper (head s) : map toLower (tail s)]
+            print "checkout"
+            () <- cmd "git checkout -b" s
+            return ()
+
+    aborting <- newIORef False
+    let createProcessAlive p = do
+            t <- myThreadId
+            (_,_,_,pid) <- createProcess p
+            forkIO $ do
+                waitForProcess pid
+                b <- readIORef aborting
+                when (not b) $ throwTo t $ ErrorCall "Process died"
+            sleep 2
+            return pid
+    exe <- getExecutablePath
+    createDirectoryIfMissing True $ dir </> "server"
+    environment <- fmap (("REPO",dir ++ "/repo"):) $ getEnvironment
+    p0 <- createProcessAlive (proc exe ["server"])
+        {cwd=Just $ dir </> "server", env=Just environment}
+    ps <- forM Example.platforms $ \p -> do
+        sleep 0.5 -- so they don't ping at the same time
+        createDirectoryIfMissing True $ dir </> "client-" ++ show p
+        createProcessAlive (proc exe ["client","--ping=1","--name=" ++ show p])
+            {cwd=Just $ dir </> "client-" ++ show p,env=Just $ ("PLATFORM",show p) : environment}
+    flip finally (do writeIORef aborting True; mapM_ terminateProcess $ p0 : ps) $ do
+        let edit name act = withCurrentDirectory (dir </> "repo-" ++ name) $ do
+                act
+                () <- cmd "git add *"
+                () <- cmd "git commit -m" ["Update from " ++ name]
+                () <- cmd "git push origin" name
+                Stdout sha1 <- cmd "git rev-parse HEAD"
+                print "adding patch"
+                () <- cmd exe "addpatch" ("--name=" ++ sha1) ("--author=" ++ name)
+                return ()
+
+        putStrLn "% MAKING EDIT AS BOB"
+        edit "bob" $
+            writeFile "Main.hs" "module Main(main) where\n\n-- Entry point\nmain = print 1\n"
+        sleep 2
+        putStrLn "% MAKING EDIT AS TONY"
+        edit "tony" $
+            writeFile "Main.hs" "module Main where\n\n-- Entry point\nmain :: IO ()\nmain = print 1\n"
+
+        sleep 10
+        withTempDir $ \d -> withCurrentDirectory d $ do
+            unit $ cmd "git clone" (dir </> "repo") "."
+            unit $ cmd "git checkout master"
+            src <- readFile "Main.hs"
+            let expect = "module Main(main) where\n\n-- Entry point\nmain :: IO ()\nmain = print 1\n"
+            when (src /= expect) $ do
+                error $ "Expected to have updated Main, but got:\n" ++ src
+
+        putStrLn "% MAKING A GOOD EDIT AS BOB"
+        edit "bob" $ do
+            unit $ cmd "git fetch origin"
+            unit $ cmd "git merge origin/master"
+            writeFile "Main.hs" "module Main(main) where\n\n-- Entry point\nmain :: IO ()\nmain = print 1\n\n"
+        putStrLn "% MAKING A BAD EDIT AS BOB"
+        edit "bob" $
+            writeFile "Main.hs" "module Main(main) where\nimport System.Environment\n-- Entry point\nmain :: IO ()\nmain = do [[_]] <- getArgs; print 1\n\n"
+        putStrLn "% MAKING A GOOD EDIT AS TONY"
+        edit "tony" $ do
+            unit $ cmd "git fetch origin"
+            unit $ cmd "git merge origin/master"
+            writeFile "Main.hs" "-- Tony waz ere\nmodule Main(main) where\n\n-- Entry point\nmain :: IO ()\nmain = print 1\n"
+
+        sleep 10
+        withTempDir $ \d -> withCurrentDirectory d $ do
+            unit $ cmd "git clone" (dir </> "repo") "."
+            unit $ cmd "git checkout master"
+            src <- readFile "Main.hs"
+            let expect = "-- Tony waz ere\nmodule Main(main) where\n\n-- Entry point\nmain :: IO ()\nmain = print 1\n\n"
+            when (src /= expect) $ do
+                error $ "Expected to have updated Main, but got:\n" ++ src
+
+        putStrLn "Completed successfully!"