diff --git a/Development/Make/All.hs b/Development/Make/All.hs
new file mode 100644
--- /dev/null
+++ b/Development/Make/All.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE RecordWildCards, PatternGuards, CPP #-}
+
+module Development.Make.All(runMakefile) where
+
+import System.Environment
+import Development.Shake
+import Development.Shake.FilePath
+import Development.Make.Parse
+import Development.Make.Env
+import Development.Make.Rules
+import Development.Make.Type
+import qualified System.Directory as IO
+import Data.List
+import Data.Maybe
+import Control.Arrow
+import Control.Monad
+import System.Cmd
+import System.Exit
+import Control.Monad.Trans.State.Strict
+
+
+runMakefile :: FilePath -> [String] -> IO (Rules ())
+runMakefile file args = do
+    env <- defaultEnv
+    mk <- parse file
+    rs <- eval env mk
+    return $ do
+        defaultRuleFile_
+        case filter (not . isPrefixOf "." . target) rs of
+            Ruler x _ _ : _ | null args, '%' `notElem` x -> want_ [x]
+            _ -> return ()
+        mapM_ (want_ . return) args
+        convert rs
+
+
+data Ruler = Ruler
+    {target :: String
+    ,prereq :: (Env, Expr) -- Env is the Env at this point
+    ,cmds :: (Env, [Command]) -- Env is the Env at the end
+    }
+
+
+eval :: Env -> Makefile -> IO [Ruler]
+eval env (Makefile xs) = do
+    (rs, env) <- runStateT (fmap concat $ mapM f xs) env
+    return [r{cmds=(env,snd $ cmds r)} | r <- rs]
+    where
+        f :: Stmt -> StateT Env IO [Ruler]
+        f Assign{..} = do
+            e <- get
+            e <- liftIO $ addEnv name assign expr e
+            put e
+            return []
+
+        f Rule{..} = do
+            e <- get
+            target <- liftIO $ fmap words $ askEnv e targets
+            return $ map (\t -> Ruler t (e, prerequisites) (undefined, commands)) target
+
+
+convert :: [Ruler] -> Rules ()
+convert rs = match ??> run
+    where
+        match s = any (isJust . check s) rs
+        check s r = makePattern (target r) s
+
+        run target =  do
+            let phony = has False ".PHONY" target
+            let silent = has True ".SILENT" target
+            (deps, cmds) <- fmap (first concat . second concat . unzip) $ forM rs $ \r ->
+                case check target r of
+                    Nothing -> return ([], [])
+                    Just op -> do
+                        let (preEnv,preExp) = prereq r
+                        env <- liftIO $ addEnv "@" Equals (Lit target) preEnv
+                        pre <- liftIO $ askEnv env preExp
+                        vp <- liftIO $ fmap splitSearchPath $ askEnv env $ Var "VPATH"
+                        pre <- mapM (vpath vp) $ words $ op pre
+                        return (pre, [cmds r])
+            mapM_ (need_ . return) deps
+            forM_ cmds $ \(env,cmd) -> do
+                env <- liftIO $ addEnv "@" Equals (Lit target) env
+                env <- liftIO $ addEnv "^" Equals (Lit $ unwords deps) env
+                env <- liftIO $ addEnv "<" Equals (Lit $ head $ deps ++ [""]) env
+                forM_ cmd $ \c ->
+                    case c of
+                        Expr c -> (if silent then quietly else id) $
+                            runCommand =<< liftIO (askEnv env c)
+            return $ if phony then Phony else NotPhony
+
+        has auto name target =
+            or [(null ws && auto) || target `elem` ws | Ruler t (_,Lit s) _ <- rs, t == name, let ws = words s]
+
+
+runCommand :: String -> Action ()
+runCommand x = do
+    res <- if "@" `isPrefixOf` x then sys $ drop 1 x
+           else putNormal x >> sys x
+    when (res /= ExitSuccess) $
+        error $ "System command failed: " ++ x
+    where sys = quietly . traced (unwords $ take 1 $ words x) . system
+
+
+makePattern :: String -> FilePath -> Maybe (String -> String)
+makePattern pat v = case break (== '%') pat of
+    (pre,'%':post) -> if pre `isPrefixOf` v && post `isSuffixOf` v && rest >= 0
+                      then Just $ concatMap (\x -> if x == '%' then subs else [x])
+                      else Nothing
+        where rest = length v - (length pre + length post)
+              subs = take rest $ drop (length pre) v
+    otherwise -> if pat == v then Just id else Nothing
+
+
+vpath :: [FilePath] -> FilePath -> Action FilePath
+vpath [] y = return y
+vpath (x:xs) y = do
+    b <- doesFileExist $ x </> y
+    if b then return $ x </> y else vpath xs y
+
+
+defaultEnv :: IO Env
+defaultEnv = do
+#if __GLASGOW_HASKELL__ >= 706
+    exePath <- getExecutablePath
+#else
+    exePath <- getProgName
+#endif
+
+    env <- getEnvironment
+    cur <- IO.getCurrentDirectory
+    return $ newEnv $
+        ("EXE",if null exe then "" else "." ++ exe) :
+        ("MAKE",normalise exePath) :
+        ("CURDIR",normalise cur) :
+        env
diff --git a/Development/Make/Main.hs b/Development/Make/Main.hs
deleted file mode 100644
--- a/Development/Make/Main.hs
+++ /dev/null
@@ -1,161 +0,0 @@
-{-# LANGUAGE RecordWildCards, PatternGuards, CPP #-}
-
-module Development.Make.Main(main) where
-
-import System.Environment
-import Development.Shake
-import Development.Shake.FilePath
-import Development.Make.Parse
-import Development.Make.Env
-import Development.Make.Rules
-import Development.Make.Type
-import qualified System.Directory as IO
-import Data.List
-import Data.Maybe
-import Control.Arrow
-import Control.Monad
-import System.Cmd
-import System.Exit
-import Control.Monad.Trans.State.Strict
-import System.Console.GetOpt
-
-
-main :: IO ()
-main = do
-    args <- getArgs
-    withArgs ("--no-time":args) $
-        shakeArgsWith shakeOptions flags $ \opts targets -> do
-            makefile <- case reverse [x | UseMakefile x <- opts] of
-                x:_ -> return x
-                _ -> findMakefile
-            fmap Just $ runMakefile makefile targets
-
-
-data Flag = UseMakefile FilePath
-
-flags = [Option "f" ["file","makefile"] (ReqArg (Right . UseMakefile) "FILE") "Read FILE as a makefile."]
-
-
-findMakefile :: IO FilePath
-findMakefile = do
-    b <- IO.doesFileExist "makefile"
-    if b then return "makefile" else do
-        b <- IO.doesFileExist "Makefile"
-        if b then return "Makefile" else
-            error "Could not find either `makefile' or `Makefile'"
-
-
-runMakefile :: FilePath -> [String] -> IO (Rules ())
-runMakefile file args = do
-    env <- defaultEnv
-    mk <- parse file
-    rs <- eval env mk
-    return $ do
-        defaultRuleFile_
-        case filter (not . isPrefixOf "." . target) rs of
-            Ruler x _ _ : _ | null args, '%' `notElem` x -> want_ [x]
-            _ -> return ()
-        mapM_ (want_ . return) args
-        convert rs
-
-
-data Ruler = Ruler
-    {target :: String
-    ,prereq :: (Env, Expr) -- Env is the Env at this point
-    ,cmds :: (Env, [Command]) -- Env is the Env at the end
-    }
-
-
-eval :: Env -> Makefile -> IO [Ruler]
-eval env (Makefile xs) = do
-    (rs, env) <- runStateT (fmap concat $ mapM f xs) env
-    return [r{cmds=(env,snd $ cmds r)} | r <- rs]
-    where
-        f :: Stmt -> StateT Env IO [Ruler]
-        f Assign{..} = do
-            e <- get
-            e <- liftIO $ addEnv name assign expr e
-            put e
-            return []
-
-        f Rule{..} = do
-            e <- get
-            target <- liftIO $ fmap words $ askEnv e targets
-            return $ map (\t -> Ruler t (e, prerequisites) (undefined, commands)) target
-
-
-convert :: [Ruler] -> Rules ()
-convert rs = match ??> run
-    where
-        match s = any (isJust . check s) rs
-        check s r = makePattern (target r) s
-
-        run target =  do
-            let phony = has False ".PHONY" target
-            let silent = has True ".SILENT" target
-            (deps, cmds) <- fmap (first concat . second concat . unzip) $ forM rs $ \r ->
-                case check target r of
-                    Nothing -> return ([], [])
-                    Just op -> do
-                        let (preEnv,preExp) = prereq r
-                        env <- liftIO $ addEnv "@" Equals (Lit target) preEnv
-                        pre <- liftIO $ askEnv env preExp
-                        vp <- liftIO $ fmap splitSearchPath $ askEnv env $ Var "VPATH"
-                        pre <- mapM (vpath vp) $ words $ op pre
-                        return (pre, [cmds r])
-            mapM_ (need_ . return) deps
-            forM_ cmds $ \(env,cmd) -> do
-                env <- liftIO $ addEnv "@" Equals (Lit target) env
-                env <- liftIO $ addEnv "^" Equals (Lit $ unwords deps) env
-                env <- liftIO $ addEnv "<" Equals (Lit $ head $ deps ++ [""]) env
-                forM_ cmd $ \c ->
-                    case c of
-                        Expr c -> (if silent then quietly else id) $
-                            runCommand =<< liftIO (askEnv env c)
-            return $ if phony then Phony else NotPhony
-
-        has auto name target =
-            or [(null ws && auto) || target `elem` ws | Ruler t (_,Lit s) _ <- rs, t == name, let ws = words s]
-
-
-runCommand :: String -> Action ()
-runCommand x = do
-    res <- if "@" `isPrefixOf` x then sys $ drop 1 x
-           else putNormal x >> sys x
-    when (res /= ExitSuccess) $
-        error $ "System command failed: " ++ x
-    where sys = quietly . traced (unwords $ take 1 $ words x) . system
-
-
-makePattern :: String -> FilePath -> Maybe (String -> String)
-makePattern pat v = case break (== '%') pat of
-    (pre,'%':post) -> if pre `isPrefixOf` v && post `isSuffixOf` v && rest >= 0
-                      then Just $ concatMap (\x -> if x == '%' then subs else [x])
-                      else Nothing
-        where rest = length v - (length pre + length post)
-              subs = take rest $ drop (length pre) v
-    otherwise -> if pat == v then Just id else Nothing
-
-
-vpath :: [FilePath] -> FilePath -> Action FilePath
-vpath [] y = return y
-vpath (x:xs) y = do
-    b <- doesFileExist $ x </> y
-    if b then return $ x </> y else vpath xs y
-
-
-defaultEnv :: IO Env
-defaultEnv = do
-#if __GLASGOW_HASKELL__ >= 706
-    exePath <- getExecutablePath
-#else
-    exePath <- getProgName
-#endif
-
-    env <- getEnvironment
-    cur <- IO.getCurrentDirectory
-    return $ newEnv $
-        ("EXE",if null exe then "" else "." ++ exe) :
-        ("MAKE",normalise exePath) :
-        ("CURDIR",normalise cur) :
-        env
diff --git a/Development/Ninja/All.hs b/Development/Ninja/All.hs
new file mode 100644
--- /dev/null
+++ b/Development/Ninja/All.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE RecordWildCards, PatternGuards, ScopedTypeVariables #-}
+
+module Development.Ninja.All(runNinja) where
+
+import Development.Ninja.Type
+import Development.Ninja.Parse
+import Development.Shake hiding (Rule)
+import Development.Shake.Command
+import Development.Shake.FilePath
+import Development.Shake.Timing
+import qualified Data.ByteString.Char8 as BS
+
+import System.Directory
+import qualified Data.HashMap.Strict as Map
+import Control.Monad
+import Data.List
+import Data.Char
+
+
+runNinja :: FilePath -> [String] -> IO (Rules ())
+runNinja file args = do
+    addTiming "Ninja parse"
+    ninja@Ninja{..} <- parse file
+    return $ do
+        phonys <- return $ Map.fromList phonys
+        singles <- return $ Map.fromList singles
+        multiples <- return $ Map.fromList [(x,(xs,b)) | (xs,b) <- multiples, x <- xs]
+        rules <- return $ Map.fromList rules
+        pools <- fmap Map.fromList $ forM pools $ \(name,depth) ->
+            fmap ((,) name) $ newResource (BS.unpack name) depth
+
+        want $ map (normalise . BS.unpack) $ concatMap (resolvePhony phonys) $ if null args then defaults else map BS.pack args
+
+        (\x -> fmap (map BS.unpack . fst) $ Map.lookup (BS.pack x) multiples) ?>> \out -> let out2 = map BS.pack out in
+            build defines phonys rules pools out2 $ snd $ multiples Map.! head out2
+
+        (flip Map.member singles . BS.pack) ?> \out -> let out2 = BS.pack out in
+            build defines phonys rules pools [out2] $ singles Map.! out2
+
+
+resolvePhony :: Map.HashMap Str [Str] -> Str -> [Str]
+resolvePhony mp = f $ Left 100
+    where
+        f (Left 0) x = f (Right []) x
+        f (Right xs) x | x `elem` xs = error $ "Recursive phony involving " ++ BS.unpack x
+        f a x = case Map.lookup x mp of
+            Nothing -> [x]
+            Just xs -> concatMap (f $ either (Left . subtract 1) (Right . (x:)) a) xs
+
+
+build :: Env -> Map.HashMap Str [Str] -> Map.HashMap Str Rule -> Map.HashMap Str Resource -> [Str] -> Build -> Action ()
+build env phonys rules pools out Build{..} = do
+    need $ map (normalise . BS.unpack) $ concatMap (resolvePhony phonys) $ depsNormal ++ depsImplicit ++ depsOrderOnly
+    case Map.lookup ruleName rules of
+        Nothing -> error $ "Ninja rule named " ++ BS.unpack ruleName ++ " is missing, required to build " ++ BS.unpack (BS.unwords out)
+        Just Rule{..} -> do
+            env <- return $
+                addBinds ruleBind $ addBinds buildBind $
+                addEnv (BS.pack "in_newline") (BS.unlines depsNormal) $
+                addEnv (BS.pack "in") (BS.unwords depsNormal) $
+                addEnv (BS.pack "out") (BS.unwords out) env
+
+            applyRspfile env $ do
+                let commandline = BS.unpack $ askVar env $ BS.pack "command"
+                let depfile = BS.unpack $ askVar env $ BS.pack "depfile"
+                let deps = BS.unpack $ askVar env $ BS.pack "deps"
+                let description = BS.unpack $ askVar env $ BS.pack "description"
+                let pool = askVar env $ BS.pack "pool"
+
+                let withPool act = case Map.lookup pool pools of
+                        _ | BS.null pool -> act
+                        Nothing -> error $ "Ninja pool named " ++ BS.unpack pool ++ " not found, required to build " ++ BS.unpack (BS.unwords out)
+                        Just r -> withResource r 1 act
+
+                when (description /= "") $ putNormal description
+                if deps == "msvc" then do
+                    Stdout stdout <- withPool $ command [Shell, EchoStdout True] commandline []
+                    need $ map normalise $ parseShowIncludes stdout
+                 else
+                    withPool $ command_ [Shell] commandline []
+                when (depfile /= "") $ do
+                    when (deps /= "gcc") $ need [depfile]
+                    depsrc <- liftIO $ readFile depfile
+                    need $ map normalise $ concatMap snd $ parseMakefile depsrc
+                    when (deps == "gcc") $ liftIO $ removeFile depfile
+
+
+applyRspfile :: Env -> Action a -> Action a
+applyRspfile env act
+    | rspfile == "" = act
+    | otherwise = do
+        liftIO $ BS.writeFile rspfile rspfile_content
+        res <- act
+        liftIO $ removeFile rspfile
+        return res
+    where
+        rspfile = BS.unpack $ askVar env $ BS.pack "rspfile"
+        rspfile_content = askVar env $ BS.pack "rspfile_content"
+
+
+parseShowIncludes :: String -> [FilePath]
+parseShowIncludes out = [y | x <- lines out, Just x <- [stripPrefix "Note: including file:" x]
+                           , let y = dropWhile isSpace x, not $ isSystemInclude y]
+
+
+-- Dodgy, but ported over from the original Ninja
+isSystemInclude :: String -> Bool
+isSystemInclude x = "program files" `isInfixOf` lx || "microsoft visual studio" `isInfixOf` lx
+    where lx = map toLower x
+
+
+parseMakefile :: String -> [(FilePath, [FilePath])]
+parseMakefile = concatMap f . join . lines
+    where
+        join (x1:x2:xs) | "\\" `isSuffixOf` x1 = join $ (init x1 ++ x2) : xs
+        join (x:xs) = x : join xs
+        join [] = []
+
+        f x = [(a, words $ drop 1 b) | a <- words a]
+            where (a,b) = break (== ':') $ takeWhile (/= '#') x
diff --git a/Development/Ninja/Parse.hs b/Development/Ninja/Parse.hs
new file mode 100644
--- /dev/null
+++ b/Development/Ninja/Parse.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE PatternGuards, RecordWildCards #-}
+
+-- | Parsing is a slow point, the below is optimised
+module Development.Ninja.Parse(parse) where
+
+import qualified Data.ByteString.Char8 as BS
+import Development.Ninja.Type
+import Control.Arrow
+import Control.Monad
+import Data.Char
+import Data.Maybe
+
+
+endsDollar :: Str -> Bool
+endsDollar = BS.isSuffixOf (BS.pack "$")
+
+dropSpace :: Str -> Str
+dropSpace = BS.dropWhile isSpace
+
+startsSpace :: Str -> Bool
+startsSpace = BS.isPrefixOf (BS.pack " ")
+
+linesCR :: Str -> [Str]
+linesCR x | BS.null x = []
+          | otherwise = case BS.elemIndex '\n' x of
+                Nothing -> [x]
+                Just i | i >= 1 && BS.index x (i-1) == '\r' -> BS.take (i-1) x : linesCR (BS.drop (i+1) x)
+                       | otherwise -> BS.take i x : linesCR (BS.drop (i+1) x)
+
+
+word1 :: Str -> (Str, Str)
+word1 x = (a, dropSpace b)
+    where (a,b) = BS.break isSpace x
+
+isVar :: Char -> Bool
+isVar x = isAlphaNum x || x == '_'
+
+parse :: FilePath -> IO Ninja
+parse file = parseFile file newNinja
+
+
+parseFile :: FilePath -> Ninja -> IO Ninja
+parseFile file ninja = do
+    src <- if file == "-" then BS.getContents else BS.readFile file
+    foldM applyStmt ninja $ splitStmts src
+
+
+data Stmt = Stmt Str [Str] deriving Show
+
+
+splitStmts :: Str -> [Stmt]
+splitStmts = stmt . continuation . linesCR
+    where
+        continuation (x:xs) | endsDollar x = BS.concat (BS.init x : map (dropSpace . BS.init) a ++ map dropSpace (take 1 b)) : continuation (drop 1 b)
+            where (a,b) = span endsDollar xs
+        continuation (x:xs) = x : continuation xs
+        continuation [] = []
+
+        stmt [] = []
+        stmt (x:xs) = Stmt x (map dropSpace a) : stmt b
+            where (a,b) = span startsSpace xs
+
+
+applyStmt :: Ninja -> Stmt -> IO Ninja
+applyStmt ninja@Ninja{..} (Stmt x xs)
+    | key == BS.pack "rule" =
+        return ninja{rules = (BS.takeWhile isVar rest, Rule $ parseBinds xs) : rules}
+    | key == BS.pack "default" =
+        return ninja{defaults = parseStrs defines rest ++ defaults}
+    | key == BS.pack "pool" =
+        return ninja{pools = (BS.takeWhile isVar rest, getDepth $ map (second $ askExpr defines) $ parseBinds xs) : pools}
+    | key == BS.pack "build",
+        (out,rest) <- splitColon rest,
+        outputs <- parseStrs defines out,
+        (rule,deps) <- word1 $ dropSpace rest,
+        (normal,implicit,orderOnly) <- splitDeps $ parseStrs defines deps,
+        let build = Build rule normal implicit orderOnly $ parseBinds xs
+        = return $
+            if rule == BS.pack "phony" then ninja{phonys = [(x, normal) | x <- outputs] ++ phonys}
+            else if length outputs == 1 then ninja{singles = (head outputs, build) : singles}
+            else ninja{multiples = (outputs, build) : multiples}
+    | key == BS.pack "include" = parseFile (BS.unpack rest) ninja
+    | key == BS.pack "subninja" = do
+        ninja <- parseFile (BS.unpack rest) ninja
+        -- restore to the original environment after, which is what Ninja actually does
+        return ninja{defines = defines}
+    | Just (a,b) <- parseBind x = return ninja{defines = addBind a b defines}
+    | BS.null $ dropSpace x = return ninja
+    | BS.pack "#" `BS.isPrefixOf` dropSpace x = return ninja -- comments can only occur on their own line
+    | otherwise = error $ "Cannot parse line: " ++ BS.unpack x
+    where (key,rest) = word1 x
+
+
+getDepth :: [(Str, Str)] -> Int
+getDepth xs = case lookup (BS.pack "depth") xs of
+    Nothing -> 1
+    Just x | Just (i, n) <- BS.readInt x, BS.null n -> i
+           | otherwise -> error $ "Could not parse depth field in pool, got: " ++ BS.unpack x
+
+
+parseBind :: Str -> Maybe (Str, Expr)
+parseBind x
+    | (var,rest) <- BS.span isVar x
+    , Just ('=',rest) <- BS.uncons $ dropSpace rest
+    = Just (var, parseExpr $ dropSpace rest)
+    | otherwise = Nothing
+
+
+parseBinds :: [Str] -> [(Str, Expr)]
+parseBinds = map $ \x -> fromMaybe (error $ "Unknown Ninja binding: " ++ BS.unpack x) $ parseBind x
+
+
+parseExpr :: Str -> Expr
+parseExpr = exprs . f
+    where
+        exprs [x] = x
+        exprs xs = Exprs xs
+
+        f x = Lit a : g (BS.drop 1 b)
+            where (a,b) = BS.break (== '$') x
+
+        g x = case BS.uncons x of
+            Nothing -> []
+            Just (c,s)
+                | c == '$' -> Lit (BS.singleton '$') : f s
+                | c == ' ' -> Lit (BS.singleton ' ') : f s
+                | c == ':' -> Lit (BS.singleton ':') : f s
+                | c == '{' -> let (a,b) = BS.break (== '}') s in Var a : f (BS.drop 1 b)
+                | otherwise -> let (a,b) = BS.span isVar x in Var a : f b
+
+
+parseStrs :: Env -> Str -> [Str]
+parseStrs env = map (askExpr env) . parseExprs
+
+
+
+splitDeps :: [Str] -> ([Str], [Str], [Str])
+splitDeps (x:xs) | x == BS.pack "|" = ([],a++b,c)
+                 | x == BS.pack "||" = ([],b,a++c)
+                 | otherwise = (x:a,b,c)
+    where (a,b,c) = splitDeps xs
+splitDeps [] = ([], [], [])
+
+
+parseExprs :: Str -> [Expr]
+parseExprs = map parseExpr . f
+    where
+        f x | BS.null x = []
+            | otherwise = let (a,b) = splitUnescaped ' ' x in a : f b
+
+
+splitUnescaped :: Char -> Str -> (Str, Str)
+splitUnescaped c x = case filter valid $ BS.elemIndices c x of
+    [] -> (x, BS.empty)
+    i:_ -> (BS.take i x, BS.drop (i+1) x)
+    where
+        -- technically there could be $$:, so an escaped $ followed by a literal :
+        -- that seems very unlikely...
+        valid i = i == 0 || BS.index x (i-1) /= '$'
+
+-- Find a non-escape : 
+splitColon :: Str -> (Str, Str)
+splitColon = splitUnescaped ':'
diff --git a/Development/Ninja/Type.hs b/Development/Ninja/Type.hs
new file mode 100644
--- /dev/null
+++ b/Development/Ninja/Type.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE RecordWildCards, PatternGuards #-}
+
+-- | The IO in this module is only to evaluate an envrionment variable,
+--   the 'Env' itself it passed around purely.
+module Development.Ninja.Type(
+    Str, FileStr,
+    Expr(..), Env, newEnv, askVar, askExpr, addEnv, addBind, addBinds,
+    Ninja(..), newNinja, Build(..), Rule(..),
+    ) where
+
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.HashMap.Strict as Map
+import Data.Maybe
+
+
+type Str = BS.ByteString
+type FileStr = Str
+
+
+---------------------------------------------------------------------
+-- ENVIRONMENT
+
+newtype Env = Env (Map.HashMap Str Str) deriving Show
+
+data Expr = Exprs [Expr] | Lit Str | Var Str deriving Show
+
+newEnv :: Env
+newEnv = Env Map.empty
+
+askExpr :: Env -> Expr -> Str
+askExpr e = f
+    where f (Exprs xs) = BS.concat $ map f xs
+          f (Lit x) = x
+          f (Var x) = askVar e x
+
+askVar :: Env -> Str -> Str
+askVar (Env e) x = fromMaybe BS.empty $ Map.lookup x e
+
+addEnv :: Str -> Str -> Env -> Env
+addEnv k v (Env e) = Env $ Map.insert k v e
+
+addBind :: Str -> Expr -> Env -> Env
+addBind k v env = addEnv k (askExpr env v) env
+
+addBinds :: [(Str, Expr)] -> Env -> Env
+addBinds kvs e = foldl (\e (k,v) -> addBind k v e) e kvs
+
+
+---------------------------------------------------------------------
+-- STRUCTURE
+
+data Ninja = Ninja
+    {defines :: !Env
+    ,rules :: [(Str,Rule)]
+    ,singles :: [(FileStr,Build)]
+    ,multiples :: [([FileStr], Build)]
+    ,phonys :: ([(Str, [FileStr])])
+    ,defaults :: [FileStr]
+    ,pools :: [(Str, Int)]
+    }
+    deriving Show
+
+newNinja :: Ninja
+newNinja = Ninja newEnv [] [] [] [] [] []
+
+data Build = Build
+    {ruleName :: Str
+    ,depsNormal :: [FileStr]
+    ,depsImplicit :: [FileStr]
+    ,depsOrderOnly :: [FileStr]
+    ,buildBind :: [(Str,Expr)]
+    } deriving Show
+
+data Rule = Rule
+    {ruleBind :: [(Str,Expr)]
+    } deriving Show
diff --git a/Development/Shake.hs b/Development/Shake.hs
--- a/Development/Shake.hs
+++ b/Development/Shake.hs
@@ -10,7 +10,7 @@
 --main = 'shakeArgs' 'shakeOptions' $ do
 --    'want' [\"result.tar\"]
 --    \"*.tar\" '*>' \\out -> do
---        contents <- 'readFileLines' $ 'Development.Shake.FilePath.replaceExtension' out \"txt\"
+--        contents \<- 'readFileLines' $ out 'Development.Shake.FilePath.-<.>' \"txt\"
 --        'need' contents
 --        'system'' \"tar\" $ [\"-cf\",out] ++ contents
 -- @
@@ -69,6 +69,7 @@
     Rule(..), Rules, defaultRule, rule, action, withoutActions,
     Action, apply, apply1, traced,
     liftIO, actionOnException, actionFinally,
+    ShakeException(..),
     -- * Configuration
     ShakeOptions(..), Assume(..),
     -- ** Command line
@@ -93,7 +94,7 @@
     -- * Special rules
     alwaysRerun,
     -- * Finite resources
-    Resource, newResource, newResourceIO, withResource,
+    Resource, newResource, newResourceIO, withResource, withResources,
     -- * Cached file contents
     newCache, newCacheIO
     ) where
@@ -105,6 +106,7 @@
 import Development.Shake.Types
 import Development.Shake.Core
 import Development.Shake.Derived
+import Development.Shake.Errors
 import Development.Shake.Progress
 import Development.Shake.Args
 import Development.Shake.Shake
diff --git a/Development/Shake/Args.hs b/Development/Shake/Args.hs
--- a/Development/Shake/Args.hs
+++ b/Development/Shake/Args.hs
@@ -6,8 +6,10 @@
 import Development.Shake.Types
 import Development.Shake.Core
 import Development.Shake.File
+import Development.Shake.FilePath
 import Development.Shake.Progress
 import Development.Shake.Shake
+import Development.Shake.Timing
 
 import Control.Arrow
 import Control.Concurrent
@@ -53,7 +55,7 @@
 -- * @main _make/henry.txt@ will not build @neil.txt@ or @emily.txt@, but will instead build @henry.txt@.
 shakeArgs :: ShakeOptions -> Rules () -> IO ()
 shakeArgs opts rules = shakeArgsWith opts [] f
-    where f _ files = return $ Just $ if null files then rules else want files >> withoutActions rules
+    where f _ files = return $ Just $ if null files then rules else want (map normalise files) >> withoutActions rules
 
 
 -- | A version of 'shakeArgs' with more flexible handling of command line arguments.
@@ -99,6 +101,7 @@
 --   Now you can pass @--distcc@ to use the @distcc@ compiler.
 shakeArgsWith :: ShakeOptions -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
 shakeArgsWith baseOpts userOptions rules = do
+    addTiming "shakeArgsWith"
     args <- getArgs
     let (flags,files,errs) = getOpt Permute opts args
         (flagsError,flag1) = partitionEithers flags
@@ -129,7 +132,9 @@
         curdir <- getCurrentDirectory
         let redir = case changeDirectory of
                 Nothing -> id
-                Just d -> bracket_ (setCurrentDirectory d) (setCurrentDirectory curdir)
+                -- get the "html" directory so it caches with the current directory
+                -- required only for debug code
+                Just d -> bracket_ (getDataFileName "html" >> setCurrentDirectory d) (setCurrentDirectory curdir)
         (ran,res) <- redir $ do
             when printDirectory $ putStrLn $ "shake: In directory `" ++ curdir ++ "'"
             rules <- rules user files
@@ -230,6 +235,7 @@
     ,yes $ Option "m" ["metadata"] (reqArg "PREFIX" $ \x s -> s{shakeFiles=x}) "Prefix for storing metadata files."
     ,no  $ Option "o" ["old-file","assume-old"] (ReqArg (\x -> Right ([AssumeOld x],id)) "FILE") "Consider FILE to be very old and don't remake it."
     ,yes $ Option ""  ["old-all"] (noArg $ \s -> s{shakeAssume=Just AssumeClean}) "Don't remake any files."
+    ,yes $ Option ""  ["assume-skip"] (noArg $ \s -> s{shakeAssume=Just AssumeSkip}) "Don't remake any files this run."
     ,yes $ Option "r" ["report"] (OptArg (\x -> Right ([], \s -> s{shakeReport=Just $ fromMaybe "report.html" x})) "FILE") "Write out profiling information [to report.html]."
     ,yes $ Option ""  ["no-report"] (noArg $ \s -> s{shakeReport=Nothing}) "Turn off --report."
     ,yes $ Option ""  ["rule-version"] (reqArg "VERSION" $ \x s -> s{shakeVersion=x}) "Version of the build rules."
@@ -237,10 +243,11 @@
     ,no  $ Option ""  ["sleep"] (NoArg $ Right ([Sleep],id)) "Sleep for a second before building."
     ,yes $ Option "S" ["no-keep-going","stop"] (noArg $ \s -> s{shakeStaunch=False}) "Turns off -k."
     ,yes $ Option ""  ["storage"] (noArg $ \s -> s{shakeStorageLog=True}) "Write a storage log."
-    ,yes $ Option "p" ["progress"] (noArg $ \s -> s{shakeProgress=progressSimple}) "Show progress messages."
+    ,yes $ Option "p" ["progress"] (optIntArg "progress" "N" (\i s -> s{shakeProgress=progressDisplay (fromMaybe 5 i) progressTitlebar})) "Show progress messages [every N seconds, default 5]."
     ,yes $ Option " " ["no-progress"] (noArg $ \s -> s{shakeProgress=const $ return ()}) "Don't show progress messages."
     ,yes $ Option "q" ["quiet"] (noArg $ \s -> s{shakeVerbosity=move (shakeVerbosity s) pred}) "Don't print much."
     ,no  $ Option ""  ["no-time"] (NoArg $ Right ([NoTime],id)) "Don't print build time."
+    ,yes $ Option ""  ["timings"] (noArg $ \s -> s{shakeTimings=True}) "Print phase timings."
     ,yes $ Option "t" ["touch"] (noArg $ \s -> s{shakeAssume=Just AssumeClean}) "Assume targets are clean."
     ,yes $ Option "V" ["verbose","trace"] (noArg $ \s -> s{shakeVerbosity=move (shakeVerbosity s) succ}) "Print tracing information."
     ,no  $ Option "v" ["version"] (NoArg $ Right ([Version],id)) "Print the version number and exit."
@@ -261,6 +268,9 @@
         intArg flag a f = flip ReqArg a $ \x -> case reads x of
             [(i,"")] | i >= 1 -> Right ([],f i)
             _ -> Left $ "the `--" ++ flag ++ "' option requires a positive integral argument"
+        optIntArg flag a f = flip OptArg a $ maybe (Right ([], f Nothing)) $ \x -> case reads x of
+            [(i,"")] | i >= 1 -> Right ([],f $ Just i)
+            _ -> Left $ "the `--" ++ flag ++ "' option only allows a positive integral argument"
         pairArg flag a f = flip ReqArg a $ \x -> case break (== '=') x of
             (a,'=':b) -> Right ([],f (a,b))
             _ -> Left $ "the `--" ++ flag ++ "' option requires an = in the argument"
diff --git a/Development/Shake/Command.hs b/Development/Shake/Command.hs
--- a/Development/Shake/Command.hs
+++ b/Development/Shake/Command.hs
@@ -186,15 +186,15 @@
 
 -- | Collect the @stdout@ of the process.
 --   If you are collecting the @stdout@, it will not be echoed to the terminal, unless you include 'EchoStdout'.
-newtype Stdout = Stdout String
+newtype Stdout = Stdout {fromStdout :: String}
 
 -- | Collect the @stderr@ of the process.
 --   If you are collecting the @stderr@, it will not be echoed to the terminal, unless you include 'EchoStderr'.
-newtype Stderr = Stderr String
+newtype Stderr = Stderr {fromStderr :: String}
 
 -- | Collect the 'ExitCode' of the process.
 --   If you do not collect the exit code, any 'ExitFailure' will cause an exception.
-newtype Exit = Exit ExitCode
+newtype Exit = Exit {fromExit :: ExitCode}
 
 -- | A class for specifying what results you want to collect from a process.
 --   Values are formed of 'Stdout', 'Stderr', 'Exit' and tuples of those.
@@ -205,6 +205,9 @@
 
 instance CmdResult Exit where
     cmdResult = ([ResultCode $ ExitSuccess], \[ResultCode x] -> Exit x)
+
+instance CmdResult ExitCode where
+    cmdResult = ([ResultCode $ ExitSuccess], \[ResultCode x] -> x)
 
 instance CmdResult Stdout where
     cmdResult = ([ResultStdout ""], \[ResultStdout x] -> Stdout x)
diff --git a/Development/Shake/Core.hs b/Development/Shake/Core.hs
--- a/Development/Shake/Core.hs
+++ b/Development/Shake/Core.hs
@@ -14,7 +14,7 @@
     Rule(..), Rules, defaultRule, rule, action, withoutActions,
     Action, actionOnException, actionFinally, apply, apply1, traced,
     getVerbosity, putLoud, putNormal, putQuiet, quietly,
-    Resource, newResource, newResourceIO, withResource,
+    Resource, newResource, newResourceIO, withResource, withResources,
     -- Internal stuff
     rulesIO, runAfter
     ) where
@@ -44,6 +44,7 @@
 import Development.Shake.Report
 import Development.Shake.Types
 import Development.Shake.Errors
+import Development.Shake.Timing
 
 
 ---------------------------------------------------------------------
@@ -252,13 +253,14 @@
     let diagnostic = if shakeVerbosity >= Diagnostic then outputLocked Diagnostic . ("% "++) else const $ return ()
     let output v = outputLocked v . abbreviate shakeAbbreviations
 
-    except <- newVar (Nothing :: Maybe SomeException)
+    except <- newIORef (Nothing :: Maybe (String, SomeException))
     let staunch act | not shakeStaunch = act >> return ()
                     | otherwise = do
             res <- try act
             case res of
                 Left err -> do
-                    modifyVar_ except $ \v -> return $ Just $ fromMaybe err v
+                    let named = maybe "unknown rule" shakeExceptionTarget . cast
+                    atomicModifyIORef except $ \v -> (Just $ fromMaybe (named err, err) v, ())
                     let msg = show err ++ "Continuing due to staunch mode, this error will be repeated later"
                     when (shakeVerbosity >= Quiet) $ output Quiet msg
                 Right _ -> return ()
@@ -273,28 +275,46 @@
                 "Wanted: " ++ dir ++ "\n" ++
                 "Got:    " ++ now
 
-    let ruleinfo = createRuleinfo shakeAssume rs
+    let ruleinfo = createRuleinfo rs
     running <- newIORef True
     after <- newIORef []
-    flip finally (writeIORef running False) $ do
-        withDatabase opts diagnostic $ \database -> do
-            forkIO $ shakeProgress $ do running <- readIORef running; stats <- progress database; return stats{isRunning=running}
-            runPool (shakeDeterministic || shakeThreads == 1) shakeThreads $ \pool -> do
-                let s0 = SAction database pool start ruleinfo output shakeVerbosity diagnostic lint after emptyStack [] 0 []
-                mapM_ (addPool pool . staunch . wrapStack (return []) . runAction s0) (actions rs)
-            when shakeLint $ do
-                checkValid database (runStored ruleinfo)
-                when (shakeVerbosity >= Loud) $ output Loud "Lint checking succeeded"
-            when (isJust shakeReport) $ do
-                let file = fromJust shakeReport
-                json <- showJSON database
-                when (shakeVerbosity >= Normal) $
-                    output Normal $ "Writing HTML report to " ++ file
-                buildReport json file
-        maybe (return ()) throwIO =<< readVar except
-        sequence_ . reverse =<< readIORef after
+    flip finally (writeIORef running False >> if shakeTimings then printTimings else resetTimings) $
+        withCapabilities shakeThreads $ do
+            withDatabase opts diagnostic $ \database -> do
+                forkIO $ shakeProgress $ do
+                    running <- readIORef running
+                    failure <- fmap (fmap fst) $ readIORef except
+                    stats <- progress database
+                    return stats{isRunning=running, isFailure=failure}
+                addTiming "Running rules"
+                runPool (shakeDeterministic || shakeThreads == 1) shakeThreads $ \pool -> do
+                    let s0 = SAction database pool start ruleinfo output shakeVerbosity diagnostic lint after emptyStack [] 0 []
+                    mapM_ (addPool pool . staunch . runAction s0) (actions rs)
+                when shakeLint $ do
+                    addTiming "Lint checking"
+                    checkValid database (runStored ruleinfo)
+                    when (shakeVerbosity >= Loud) $ output Loud "Lint checking succeeded"
+                when (isJust shakeReport) $ do
+                    addTiming "Profile report"
+                    let file = fromJust shakeReport
+                    json <- showJSON database
+                    when (shakeVerbosity >= Normal) $
+                        output Normal $ "Writing HTML report to " ++ file
+                    buildReport json file
+            maybe (return ()) (throwIO . snd) =<< readIORef except
+            sequence_ . reverse =<< readIORef after
 
 
+withCapabilities :: Int -> IO a -> IO a
+#if __GLASGOW_HASKELL__ >= 706
+withCapabilities new act = do
+    old <- getNumCapabilities
+    if old == new then act else
+        bracket_ (setNumCapabilities new) (setNumCapabilities old) act
+#else
+withCapabilities new act = act
+#endif
+
 lineBuffering :: IO a -> IO a
 lineBuffering = f stdout . f stderr
     where
@@ -318,10 +338,11 @@
 
 wrapStack :: IO [String] -> IO a -> IO a
 wrapStack stk act = E.catch act $ \(SomeException e) -> case cast e of
-    Just s@ShakeException{} -> throw s
+    Just s@ShakeException{} -> throwIO s
     Nothing -> do
         stk <- stk
-        throw $ ShakeException stk $ SomeException e
+        if null stk then throwIO e
+         else throwIO $ ShakeException (last stk) stk $ SomeException e
 
 
 registerWitnesses :: SRules -> IO ()
@@ -331,8 +352,8 @@
         registerWitness $ ruleValue r
 
 
-createRuleinfo :: Maybe Assume -> SRules -> Map.HashMap TypeRep RuleInfo
-createRuleinfo assume SRules{..} = flip Map.map rules $ \(_,tv,rs) -> RuleInfo (stored rs) (execute rs) tv
+createRuleinfo :: SRules -> Map.HashMap TypeRep RuleInfo
+createRuleinfo SRules{..} = flip Map.map rules $ \(_,tv,rs) -> RuleInfo (stored rs) (execute rs) tv
     where
         stored ((_,ARule r):_) = fmap (fmap newValue) . f r . fromKey
             where f :: Rule key value => (key -> Maybe (Action value)) -> (key -> IO (Maybe value))
@@ -488,3 +509,15 @@
         (runAction s act)
     Action $ State.put s
     return res
+
+
+-- | Run an action which uses part of several finite resources. Acquires the resources in a stable
+--   order, to prevent deadlock. If all rules requiring more than one resource acquire those
+--   resources with a single call to 'withResources', resources will not deadlock.
+withResources :: [(Resource, Int)] -> Action a -> Action a
+withResources res act
+    | (r,i):_ <- filter ((< 0) . snd) res = error $ "You cannot acquire a negative quantity of " ++ show r ++ ", requested " ++ show i
+    | otherwise = f $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst) res
+    where
+        f [] = act
+        f (r:rs) = withResource (fst $ head r) (sum $ map snd r) $ f rs
diff --git a/Development/Shake/Database.hs b/Development/Shake/Database.hs
--- a/Development/Shake/Database.hs
+++ b/Development/Shake/Database.hs
@@ -19,6 +19,7 @@
 import Development.Shake.Locks
 import Development.Shake.Storage
 import Development.Shake.Types
+import Development.Shake.Special
 import Development.Shake.Intern as Intern
 
 import Control.Exception
@@ -251,7 +252,10 @@
                 Nothing -> err $ "interned value missing from database, " ++ show i
                 Just (k, Missing) -> run stack i k Nothing
                 Just (k, Loaded r) -> do
-                    b <- if assume == Just AssumeDirty then return False else fmap (== Just (result r)) $ stored k
+                    b <- case assume of
+                        Just AssumeDirty -> return False
+                        Just AssumeSkip -> return True
+                        _ -> fmap (== Just (result r)) $ stored k
                     diagnostic $ "valid " ++ show b ++ " for " ++ atom k ++ " " ++ atom (result r)
                     if not b then run stack i k $ Just r else check stack i k r (depends r)
                 Just (k, res) -> return res
@@ -417,17 +421,11 @@
         (key, Ready Result{..}) -> do
             good <- fmap (== Just result) $ stored key
             diagnostic $ "Checking if " ++ show key ++ " is " ++ show result ++ ", " ++ if good then "passed" else "FAILED"
-            return [show key ++ " is no longer " ++ show result | not good && not (special key result)]
+            return [show key ++ " is no longer " ++ show result | not good && not (specialAlwaysRebuilds result)]
         _ -> return []
     if null bad
         then diagnostic "Validity/lint check passed"
         else error $ unlines $ "Error: Dependencies have changed since being built:" : bad
-
-    where
-        -- special case for these things, since the purpose is to break the invariant
-        -- FIXME: this is getting more and more hacky
-        special k r = sk == "AlwaysRerunQ" || "OracleQ " `isPrefixOf` sk || sr == "FileA (FileTime 2147483647)"
-            where sk = show k; sr = show r
 
 
 ---------------------------------------------------------------------
diff --git a/Development/Shake/Derived.hs b/Development/Shake/Derived.hs
--- a/Development/Shake/Derived.hs
+++ b/Development/Shake/Derived.hs
@@ -11,7 +11,7 @@
 import System.Process
 import System.Directory
 import System.Exit
-import qualified Data.ByteString.Char8 as BS
+import System.IO
 
 import Development.Shake.Core
 import Development.Shake.File
@@ -97,6 +97,9 @@
 writeFileChanged name x = liftIO $ do
     b <- doesFileExist name
     if not b then writeFile name x else do
-        orig <- BS.readFile name
-        let new = BS.pack x
-        when (orig /= new) $ BS.writeFile name new
+        -- Cannot use ByteString here, since it has different line handling
+        -- semantics on Windows
+        b <- withFile name ReadMode $ \h -> do
+            src <- hGetContents h
+            return $! src /= x
+        when b $ writeFile name x
diff --git a/Development/Shake/Errors.hs b/Development/Shake/Errors.hs
--- a/Development/Shake/Errors.hs
+++ b/Development/Shake/Errors.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}
+{-# LANGUAGE DeriveDataTypeable, PatternGuards, RecordWildCards #-}
 
 -- | Errors seen by the user
 module Development.Shake.Errors(
@@ -47,7 +47,7 @@
 
 
 errorNoRuleToBuildType :: TypeRep -> Maybe String -> Maybe TypeRep -> a
-errorNoRuleToBuildType tk k tv = structured (isOracle tk)
+errorNoRuleToBuildType tk k tv = structured (specialIsOracleKey tk)
     "Build system error - no _rule_ matches the _key_ type"
     [("_Key_ type", Just $ show tk)
     ,("_Key_ value", k)
@@ -55,7 +55,7 @@
     "Either you are missing a call to _rule/defaultRule_, or your call to _apply_ has the wrong _key_ type"
 
 errorRuleTypeMismatch :: TypeRep -> Maybe String -> TypeRep -> TypeRep -> a
-errorRuleTypeMismatch tk k tvReal tvWant = structured (isOracle tk)
+errorRuleTypeMismatch tk k tvReal tvWant = structured (specialIsOracleKey tk)
     "Build system error - _rule_ used at the wrong _result_ type"
     [("_Key_ type", Just $ show tk)
     ,("_Key_ value", k)
@@ -64,7 +64,7 @@
     "Either the function passed to _rule/defaultRule_ has the wrong _result_ type, or the result of _apply_ is used at the wrong type"
 
 errorIncompatibleRules :: TypeRep -> TypeRep -> TypeRep -> a
-errorIncompatibleRules tk tv1 tv2 = if isOracle tk then errorDuplicateOracle tk Nothing [tv1,tv2] else structured_
+errorIncompatibleRules tk tv1 tv2 = if specialIsOracleKey tk then errorDuplicateOracle tk Nothing [tv1,tv2] else structured_
     "Build system error - rule has multiple result types"
     [("Key type", Just $ show tk)
     ,("First result type", Just $ show tv1)
@@ -73,7 +73,7 @@
 
 errorMultipleRulesMatch :: TypeRep -> String -> Int -> a
 errorMultipleRulesMatch tk k count
-    | isOracle tk = if count == 0 then err $ "no oracle match for " ++ show tk else errorDuplicateOracle tk (Just k) []
+    | specialIsOracleKey tk = if count == 0 then err $ "no oracle match for " ++ show tk else errorDuplicateOracle tk (Just k) []
     | otherwise = structured_
     ("Build system error - key matches " ++ (if count == 0 then "no" else "multiple") ++ " rules")
     [("Key type",Just $ show tk)
@@ -98,24 +98,25 @@
     "Only one call to addOracle is allowed per question type"
 
 
-isOracle :: TypeRep -> Bool
-isOracle t = con `elem` ["OracleQ","OracleA"]
+-- Should be in Special, but then we get an import cycle
+specialIsOracleKey :: TypeRep -> Bool
+specialIsOracleKey t = con == "OracleQ"
     where con = show $ fst $ splitTyConApp t
 
 
--- NOTE: Not currently public, to avoid pinning down the API yet
--- | All foreseen exception conditions thrown by Shake, such problems with the rules or errors when executing
---   rules, will be raised using this exception type.
+-- | Error representing all expected exceptions thrown by Shake.
+--   Problems when executing rules will be raising using this exception type.
 data ShakeException = ShakeException
-        [String] -- Entries on the stack, starting at the top of the stack.
-        SomeException -- Inner exception that was raised.
-        -- If I make these Haddock comments, then Haddock dies
+        {shakeExceptionTarget :: String -- ^ The target that was being built when the exception occured.
+        ,shakeExceptionStack :: [String]  -- ^ The stack of targets, where the 'shakeExceptionTarget' is last.
+        ,shakeExceptionInner :: SomeException -- ^ The underlying exception that was raised.
+        }
     deriving Typeable
 
 instance Exception ShakeException
 
 instance Show ShakeException where
-    show (ShakeException stack inner) = unlines $
+    show ShakeException{..} = unlines $
         "Error when running Shake build system:" :
-        map ("* " ++) stack ++
-        [show inner]
+        map ("* " ++) shakeExceptionStack ++
+        [show shakeExceptionInner]
diff --git a/Development/Shake/File.hs b/Development/Shake/File.hs
--- a/Development/Shake/File.hs
+++ b/Development/Shake/File.hs
@@ -16,11 +16,13 @@
 import Development.Shake.Core
 import Development.Shake.Types
 import Development.Shake.Classes
-import Development.Shake.FilePath
 import Development.Shake.FilePattern
 import Development.Shake.FileTime
 import Development.Shake.Locks
 
+import System.FilePath(takeDirectory) -- important that this is the system local filepath, or wrong slashes go wrong
+
+
 infix 1 *>, ?>, **>
 
 
@@ -131,6 +133,9 @@
 
 -- | Declare a phony action, this is an action that does not produce a file, and will be rerun
 --   in every execution that requires it. You can demand 'phony' rules using 'want' \/ 'need'.
+--
+--   Phony actions are intended to define command-line abbreviations. You should not 'need' phony actions
+--   as dependencies of rules, as that will cause excessive rebuilding.
 phony :: String -> Action () -> Rules ()
 phony name act = rule $ \(FileQ x_) -> let x = unpack x_ in
     if name /= x then Nothing else Just $ do
diff --git a/Development/Shake/FilePath.hs b/Development/Shake/FilePath.hs
--- a/Development/Shake/FilePath.hs
+++ b/Development/Shake/FilePath.hs
@@ -11,6 +11,7 @@
 module Development.Shake.FilePath(
     module System.FilePath.Posix,
     dropDirectory1, takeDirectory1, normalise,
+    (-<.>),
     toNative, (</>), combine,
     exe
     ) where
@@ -19,7 +20,10 @@
 import qualified System.FilePath as Native
 import Data.List
 
+infixr 5  </>
+infixr 7  -<.>
 
+
 -- | Drop the first directory from a 'FilePath'. Should only be used on
 --   relative paths.
 --
@@ -66,6 +70,9 @@
 (</>) :: FilePath -> FilePath -> FilePath
 (</>) = combine
 
+-- | Remove the current extension and add another, an alias for 'replaceExtension'.
+(-<.>) :: FilePath -> String -> FilePath
+(-<.>) = replaceExtension
 
 -- | Combine two file paths. Any leading @.\/@ or @..\/@ components in the right file
 --   are eliminated.
diff --git a/Development/Shake/FileTime.hs b/Development/Shake/FileTime.hs
--- a/Development/Shake/FileTime.hs
+++ b/Development/Shake/FileTime.hs
@@ -29,7 +29,7 @@
 type WIN32_FILE_ATTRIBUTE_DATA = Ptr ()
 type LPCSTR = Ptr CChar
 
-foreign import stdcall "Windows.h GetFileAttributesExA" c_getFileAttributesEx :: LPCSTR -> Int32 -> WIN32_FILE_ATTRIBUTE_DATA -> IO Bool
+foreign import stdcall unsafe "Windows.h GetFileAttributesExA" c_getFileAttributesEx :: LPCSTR -> Int32 -> WIN32_FILE_ATTRIBUTE_DATA -> IO Bool
 
 size_WIN32_FILE_ATTRIBUTE_DATA = 36
 
@@ -80,7 +80,7 @@
         res <- c_getFileAttributesEx file 0 info
         if not res then return Nothing else do
             -- Technically a Word32, but we can treak it as an Int32 for peek
-            dword <- peekByteOff info index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime
+            dword <- peekByteOff info index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime :: IO Int32
             return $ Just $ fileTime dword
 
 #else
diff --git a/Development/Shake/Files.hs b/Development/Shake/Files.hs
--- a/Development/Shake/Files.hs
+++ b/Development/Shake/Files.hs
@@ -36,7 +36,7 @@
 --
 -- @
 -- [\"*.o\",\"*.hi\"] '*>>' \\[o,hi] -> do
---     let hs = 'Development.Shake.FilePath.replaceExtension' o \"hs\"
+--     let hs = o 'Development.Shake.FilePath.-<.>' \"hs\"
 --     'Development.Shake.need' ... -- all files the .hs import
 --     'Development.Shake.system'' \"ghc\" [\"-c\",hs]
 -- @
diff --git a/Development/Shake/Locks.hs b/Development/Shake/Locks.hs
--- a/Development/Shake/Locks.hs
+++ b/Development/Shake/Locks.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 
 module Development.Shake.Locks(
     Lock, newLock, withLock,
@@ -8,6 +9,8 @@
 
 import Control.Concurrent
 import Control.Monad
+import Data.Function
+import System.IO.Unsafe
 
 
 ---------------------------------------------------------------------
@@ -67,6 +70,14 @@
 ---------------------------------------------------------------------
 -- RESOURCE
 
+{-# NOINLINE resourceIds #-}
+resourceIds :: Var Int
+resourceIds = unsafePerformIO $ newVar 0
+
+resourceId :: IO Int
+resourceId = modifyVar resourceIds $ \i -> let j = i + 1 in j `seq` return (j, j)
+
+
 -- | A type representing a finite resource, which multiple build actions should respect.
 --   Created with 'Development.Shake.newResource' and used with 'Development.Shake.withResource'
 --   when defining rules.
@@ -87,8 +98,9 @@
 --   is better than 'MVar' as it will not block any other threads from executing. Be careful that the
 --   actions run within 'Development.Shake.withResource' do not themselves require further quantities of this resource, or
 --   you may get a \"thread blocked indefinitely in an MVar operation\" exception. Typically only
---   system commands (such as 'Development.Shake.system'') will be run inside 'Development.Shake.withResource',
---   not commands such as 'Development.Shake.need'.
+--   system commands (such as 'Development.Shake.system'') should be run inside 'Development.Shake.withResource',
+--   not commands such as 'Development.Shake.need'. If an action requires multiple resources, use
+--   'Development.Shake.withResources' to avoid deadlock.
 --
 --   As another example, calls to compilers are usually CPU bound but calls to linkers are usually
 --   disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit
@@ -103,27 +115,31 @@
 -- \"*.o\" 'Development.Shake.*>' \\out ->
 --     'Development.Shake.system'' \"cl\" [\"-o\",out,...]
 -- @
-data Resource = Resource String Int (Var (Int,[(Int,IO ())]))
-instance Show Resource where show (Resource name _ _) = "Resource " ++ name
+data Resource = Resource {resourceKey :: Int, resourceName :: String, resourceMax :: Int, resourceVar :: Var (Int,[(Int,IO ())])}
+instance Show Resource where show Resource{..} = "Resource " ++ resourceName
 
+instance Eq Resource where (==) = (==) `on` resourceKey
+instance Ord Resource where compare = compare `on` resourceKey
 
+
 -- | A version of 'newResource' that runs in IO, and can be called before calling 'Development.Shake.shake'.
 --   Most people should use 'Development.Shake.newResource' instead.
 newResourceIO :: String -> Int -> IO Resource
 newResourceIO name mx = do
     when (mx < 0) $
         error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx
+    key <- resourceId
     var <- newVar (mx, [])
-    return $ Resource name mx var
+    return $ Resource key name mx var
 
 
 -- | Try to acquire a resource. Returns Nothing to indicate you have acquired with no blocking, or Just act to
 --   say after act completes (which will block) then you will have the resource.
 acquireResource :: Resource -> Int -> IO (Maybe (IO ()))
-acquireResource r@(Resource name mx var) want
+acquireResource r@Resource{..} want
     | want < 0 = error $ "You cannot acquire a negative quantity of " ++ show r ++ ", requested " ++ show want
-    | want > mx = error $ "You cannot acquire more than " ++ show mx ++ " of " ++ show r ++ ", requested " ++ show want
-    | otherwise = modifyVar var $ \(available,waiting) ->
+    | want > resourceMax = error $ "You cannot acquire more than " ++ show resourceMax ++ " of " ++ show r ++ ", requested " ++ show want
+    | otherwise = modifyVar resourceVar $ \(available,waiting) ->
         if want <= available then
             return ((available - want, waiting), Nothing)
         else do
@@ -133,7 +149,7 @@
 
 -- | You should only ever releaseResource that you obtained with acquireResource.
 releaseResource :: Resource -> Int -> IO ()
-releaseResource (Resource name mx var) i = modifyVar_ var $ \(available,waiting) -> f (available+i) waiting
+releaseResource Resource{..} i = modifyVar_ resourceVar $ \(available,waiting) -> f (available+i) waiting
     where
         f i ((wi,wa):ws) | wi <= i = wa >> f (i-wi) ws
                          | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)
diff --git a/Development/Shake/Progress.hs b/Development/Shake/Progress.hs
--- a/Development/Shake/Progress.hs
+++ b/Development/Shake/Progress.hs
@@ -33,6 +33,7 @@
 --   status messages, which is implemented using this data type.
 data Progress = Progress
     {isRunning :: !Bool -- ^ Starts out 'True', becomes 'False' once the build has completed.
+    ,isFailure :: !(Maybe String) -- ^ Starts out 'Nothing', becomes 'Just' if a rule fails.
     ,countSkipped :: {-# UNPACK #-} !Int -- ^ Number of rules which were required, but were already in a valid state.
     ,countBuilt :: {-# UNPACK #-} !Int -- ^ Number of rules which were have been built in this run.
     ,countUnknown :: {-# UNPACK #-} !Int -- ^ Number of rules which have been built previously, but are not yet known to be required.
@@ -45,9 +46,10 @@
     deriving (Eq,Ord,Show,Data,Typeable)
 
 instance Monoid Progress where
-    mempty = Progress True 0 0 0 0 0 0 0 (0,0)
+    mempty = Progress True Nothing 0 0 0 0 0 0 0 (0,0)
     mappend a b = Progress
         {isRunning = isRunning a && isRunning b
+        ,isFailure = isFailure a `mappend` isFailure b
         ,countSkipped = countSkipped a + countSkipped b
         ,countBuilt = countBuilt a + countBuilt b
         ,countUnknown = countUnknown a + countUnknown b
@@ -112,7 +114,7 @@
                 disp "Finished"
              else do
                 (t, msg) <- return $ tick p t
-                disp msg
+                disp $ msg ++ maybe "" (\err -> ", Failure! " ++ err) (isFailure p)
                 loop $! t
 
 
diff --git a/Development/Shake/Shake.hs b/Development/Shake/Shake.hs
--- a/Development/Shake/Shake.hs
+++ b/Development/Shake/Shake.hs
@@ -3,6 +3,7 @@
 module Development.Shake.Shake(shake) where
 
 import Development.Shake.Types
+import Development.Shake.Timing
 import Development.Shake.Core
 
 import Development.Shake.Directory
@@ -17,6 +18,7 @@
 --   To use command line flags to modify 'ShakeOptions' see 'Development.Shake.shakeArgs'.
 shake :: ShakeOptions -> Rules () -> IO ()
 shake opts r = do
+    addTiming "Function shake"
     run opts $ do
         r
         defaultRuleFile
diff --git a/Development/Shake/Special.hs b/Development/Shake/Special.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Special.hs
@@ -0,0 +1,21 @@
+
+-- | This module contains rule types that have special behaviour in some way.
+--   Everything in this module is a hack.
+module Development.Shake.Special(
+    specialAlwaysRebuilds,
+    specialIsFileKey
+    ) where
+
+import Development.Shake.Value
+import Data.List
+import Data.Typeable
+
+
+specialAlwaysRebuilds :: Value -> Bool
+specialAlwaysRebuilds v = sv == "AlwaysRerunA" || "OracleA " `isPrefixOf` sv || sv == "FileA (FileTime 2147483647)"
+    where sv = show v
+
+
+specialIsFileKey :: TypeRep -> Bool
+specialIsFileKey t = con == "FileQ"
+    where con = show $ fst $ splitTyConApp t
diff --git a/Development/Shake/Storage.hs b/Development/Shake/Storage.hs
--- a/Development/Shake/Storage.hs
+++ b/Development/Shake/Storage.hs
@@ -12,6 +12,7 @@
 import Development.Shake.Binary
 import Development.Shake.Locks
 import Development.Shake.Types
+import Development.Shake.Timing
 
 import Control.Arrow
 import Control.Exception as E
@@ -61,6 +62,7 @@
         E.catch (removeFile dbfile) (\(e :: SomeException) -> return ())
         renameFile bupfile dbfile
 
+    addTiming "Database read"
     withBinaryFile dbfile ReadWriteMode $ \h -> do
         n <- hFileSize h
         diagnostic $ "Reading file of size " ++ show n
@@ -120,6 +122,7 @@
                                 diagnostic $ "Drop complete"
                             return $ continue h mp
                          else do
+                            addTiming "Database compression"
                             unexpected "Compressing database\n"
                             diagnostic "Compressing database"
                             hClose h -- two hClose are fine
@@ -158,7 +161,9 @@
         continue h mp = do
             when (Map.null mp) $
                 reset h mp -- might as well, no data to lose, and need to ensure a good witness table
-            flushThread outputErr shakeFlush h $ \out ->
+                           -- also lets us recover in the case of corruption
+            flushThread outputErr shakeFlush h $ \out -> do
+                addTiming "With database"
                 act mp $ \k v -> out $ toChunk $ runPut $ putWith witness (k, v)
 
 
diff --git a/Development/Shake/Timing.hs b/Development/Shake/Timing.hs
new file mode 100644
--- /dev/null
+++ b/Development/Shake/Timing.hs
@@ -0,0 +1,58 @@
+
+module Development.Shake.Timing(resetTimings, addTiming, printTimings) where
+
+import Control.Arrow
+import Data.IORef
+import Data.Time
+import System.IO.Unsafe
+import Numeric
+
+
+{-# NOINLINE timings #-}
+timings :: IORef [(UTCTime, String)] -- number of times called, newest first
+timings = unsafePerformIO $ newIORef []
+
+
+resetTimings :: IO ()
+resetTimings = do
+    now <- getCurrentTime
+    writeIORef timings [(now, "Start")]
+
+
+-- | Print all withTiming information and clear the information.
+printTimings :: IO ()
+printTimings = do
+    now <- getCurrentTime
+    old <- atomicModifyIORef timings $ \ts -> ([(now, "Start")], ts)
+    putStr $ unlines $ showTimings now $ reverse old
+
+
+addTiming :: String -> IO ()
+addTiming msg = do
+    now <- getCurrentTime
+    atomicModifyIORef timings $ \ts -> ((now,msg):ts, ())
+
+
+showTimings :: UTCTime -> [(UTCTime, String)] -> [String]
+showTimings _ [] = []
+showTimings stop times = showGap $
+    [(a ++ "  ", showDP 3 b ++ "s  " ++ showPerc b ++ "  " ++ progress b) | (a,b) <- xs] ++
+    [("Total", showDP 3 sm ++ "s  " ++ showPerc sm ++ "  " ++ replicate 25 ' ')]
+    where
+        a // b = if b == 0 then 0 else a / b
+        showPerc x = let s = show $ floor $ x * 100 // sm in replicate (3 - length s) ' ' ++ s ++ "%"
+        progress x = let i = floor $ x * 25 // mx in replicate i '=' ++ replicate (25-i) ' '
+        mx = maximum $ map snd xs
+        sm = sum $ map snd xs
+        xs = [ (name, fromRational $ toRational $ stop `diffUTCTime` start)
+             | ((start, name), stop) <- zip times $ map fst (drop 1 times) ++ [stop]]
+
+
+showGap :: [(String,String)] -> [String]
+showGap xs = [a ++ replicate (n - length a - length b) ' ' ++ b | (a,b) <- xs]
+    where n = maximum [length a + length b | (a,b) <- xs]
+
+
+showDP :: Int -> Double -> String
+showDP n x = a ++ "." ++ b ++ replicate (n - length b) '0'
+    where (a,b) = second (drop 1) $ break (== '.') $ showFFloat (Just n) x ""
diff --git a/Development/Shake/Types.hs b/Development/Shake/Types.hs
--- a/Development/Shake/Types.hs
+++ b/Development/Shake/Types.hs
@@ -27,10 +27,14 @@
         --   for rebuilding if untracked dependencies have changed. This assumption is safe, but may cause
         --   more rebuilding than necessary.
     | AssumeClean
-        -- ^ /This assumption is unsafe, and may lead to incorrect build results/.
-        --   Assume that all rules reached are clean and do not require rebuilding, provided the rule
+        -- ^ /This assumption is unsafe, and may lead to incorrect build results in this run, and in future runs/.
+        --   Assume and record that all rules reached are clean and do not require rebuilding, provided the rule
         --   has a 'Development.Shake.storedValue' and has been built before. Useful if you have modified a file in some
         --   inconsequential way, such as only the comments or whitespace, and wish to avoid a rebuild.
+    | AssumeSkip
+        -- ^ /This assumption is unsafe, and may lead to incorrect build results in this run/.
+        --   Assume that all rules reached are clean in this run. Only useful for benchmarking, to remove any overhead
+        --   from running 'Development.Shake.storedValue' operations.
     deriving (Eq,Ord,Show,Data,Typeable,Bounded,Enum)
 
 
@@ -39,7 +43,7 @@
 --
 --   @ 'shakeOptions'{'shakeThreads'=4, 'shakeReport'=Just \"report.html\"} @
 --
---   The 'Data' instance for this type reports the 'shakeProgress' field as having the abstract type 'Function',
+--   The 'Data' instance for this type reports the 'shakeProgress' and 'shakeOutput' fields as having the abstract type 'Function',
 --   because 'Data' cannot be defined for functions.
 data ShakeOptions = ShakeOptions
     {shakeFiles :: FilePath
@@ -86,6 +90,8 @@
         --   on the current stored progress. Examples include database version number changes, database compaction or corrupt files.
     ,shakeLineBuffering :: Bool
         -- ^ Defaults to 'True'. Change 'stdout' and 'stderr' to line buffering while running Shake.
+    ,shakeTimings :: Bool
+        -- ^ Default to 'False'. Print timing information for each stage at the end.
     ,shakeProgress :: IO Progress -> IO ()
         -- ^ Defaults to no action. A function called on a separate thread when the build starts, allowing progress to be reported.
         --   For applications that want to display progress messages, 'progressSimple' is often sufficient, but more advanced
@@ -99,21 +105,22 @@
 
 -- | The default set of 'ShakeOptions'.
 shakeOptions :: ShakeOptions
-shakeOptions = ShakeOptions ".shake" 1 "1" Normal False Nothing False False (Just 10) Nothing [] False True (const $ return ())
+shakeOptions = ShakeOptions ".shake" 1 "1" Normal False Nothing False False (Just 10) Nothing [] False True False
+    (const $ return ())
     (const $ BS.putStrLn . BS.pack) -- try and output atomically using BS
 
 fieldsShakeOptions =
     ["shakeFiles", "shakeThreads", "shakeVersion", "shakeVerbosity", "shakeStaunch", "shakeReport"
     ,"shakeLint", "shakeDeterministic", "shakeFlush", "shakeAssume", "shakeAbbreviations", "shakeStorageLog"
-    ,"shakeLineBuffering","shakeProgress","shakeOutput"]
+    ,"shakeLineBuffering", "shakeTimings", "shakeProgress", "shakeOutput"]
 tyShakeOptions = mkDataType "Development.Shake.Types.ShakeOptions" [conShakeOptions]
 conShakeOptions = mkConstr tyShakeOptions "ShakeOptions" fieldsShakeOptions Prefix
-unhide x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 = ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 (fromFunction x14) (fromFunction x15)
+unhide x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 = ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 (fromFunction x15) (fromFunction x16)
 
 instance Data ShakeOptions where
-    gfoldl k z (ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15) =
-        z unhide `k` x1 `k` x2 `k` x3 `k` x4 `k` x5 `k` x6 `k` x7 `k` x8 `k` x9 `k` x10 `k` x11 `k` x12 `k` x13 `k` Function x14 `k` Function x15
-    gunfold k z c = k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ z unhide
+    gfoldl k z (ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16) =
+        z unhide `k` x1 `k` x2 `k` x3 `k` x4 `k` x5 `k` x6 `k` x7 `k` x8 `k` x9 `k` x10 `k` x11 `k` x12 `k` x13 `k` x14 `k` Function x15 `k` Function x16
+    gunfold k z c = k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ z unhide
     toConstr ShakeOptions{} = conShakeOptions
     dataTypeOf _ = tyShakeOptions
 
diff --git a/Examples/Self/Main.hs b/Examples/Self/Main.hs
--- a/Examples/Self/Main.hs
+++ b/Examples/Self/Main.hs
@@ -40,30 +40,30 @@
             cmd "ghc" flags args
 
     obj "/*.exe" *> \out -> do
-        src <- readFileLines $ replaceExtension out "deps"
+        src <- readFileLines $ out -<.> "deps"
         let os = map (obj . moduleToFile "o") $ "Main":src
         need os
         ghc $ ["-o",out] ++ os
 
     obj "/*.deps" *> \out -> do
-        dep <- readFileLines $ replaceExtension out "dep"
+        dep <- readFileLines $ out -<.> "dep"
         let xs = map (obj . moduleToFile "deps") dep
         need xs
         ds <- fmap (nub . sort . (++) dep . concat) $ mapM readFileLines xs
         writeFileLines out ds
 
     obj "/*.dep" *> \out -> do
-        src <- readFile' $ fixPaths $ unobj $ replaceExtension out "hs"
+        src <- readFile' $ fixPaths $ unobj $ out -<.> "hs"
         let xs = hsImports src
         xs <- filterM (doesFileExist . fixPaths . moduleToFile "hs") xs
         writeFileLines out xs
 
     obj "/*.hi" *> \out -> do
-        need [replaceExtension out "o"]
+        need [out -<.> "o"]
 
     obj "/*.o" *> \out -> do
-        dep <- readFileLines $ replaceExtension out "dep"
-        let hs = fixPaths $ unobj $ replaceExtension out "hs"
+        dep <- readFileLines $ out -<.> "dep"
+        let hs = fixPaths $ unobj $ out -<.> "hs"
         need $ hs : map (obj . moduleToFile "hi") dep
         ghc ["-c",hs,"-hide-all-packages","-odir=output/self","-hidir=output/self","-i=output/self"]
 
diff --git a/Examples/Test/Cache.hs b/Examples/Test/Cache.hs
--- a/Examples/Test/Cache.hs
+++ b/Examples/Test/Cache.hs
@@ -20,7 +20,7 @@
 test build obj = do
     writeFile (obj "trace.txt") ""
     writeFile (obj "vowels.txt") "abc123a"
-    build ["vowels.out1","vowels.out2","-j3"]
+    build ["vowels.out1","vowels.out2","-j3","--sleep"]
     assertContents (obj "trace.txt") "1"
     assertContents (obj "vowels.out1") "3"
     assertContents (obj "vowels.out2") "3"
diff --git a/Examples/Test/Docs.hs b/Examples/Test/Docs.hs
--- a/Examples/Test/Docs.hs
+++ b/Examples/Test/Docs.hs
@@ -78,7 +78,7 @@
 
     obj "Success.txt" *> \out -> do
         need [obj "Main.hs"]
-        system' "runhaskell" ["-hide-package=hashmap","-i" ++ obj "",obj "Main.hs"]
+        system' "runhaskell" ["-ignore-package=hashmap","-i" ++ obj "",obj "Main.hs"]
         writeFile' out ""
 
 
diff --git a/Examples/Test/Journal.hs b/Examples/Test/Journal.hs
--- a/Examples/Test/Journal.hs
+++ b/Examples/Test/Journal.hs
@@ -18,8 +18,7 @@
     want $ map obj ["a.out","b.out","c.out"]
     obj "*.out" *> \out -> do
         liftIO $ atomicModifyIORef rebuilt $ \a -> (a+1,())
-        let src = replaceExtension out "in"
-        copyFile' src out
+        copyFile' (out -<.> "in") out
 
 
 test build obj = do
diff --git a/Examples/Test/Lint.hs b/Examples/Test/Lint.hs
--- a/Examples/Test/Lint.hs
+++ b/Examples/Test/Lint.hs
@@ -23,12 +23,17 @@
         () <- askOracle ()
         writeFile' out ""
 
+    obj "pause.*" *> \out -> do
+        liftIO $ sleep 0.1
+        need [obj "cdir" <.> takeExtension out]
+        writeFile' out ""
+
     obj "cdir.*" *> \out -> do
         pwd <- liftIO getCurrentDirectory
         let dir2 = obj $ "dir" ++ takeExtension out
         liftIO $ createDirectoryIfMissing True dir2
         liftIO $ setCurrentDirectory dir2
-        liftIO $ sleep 0.1
+        liftIO $ sleep 0.2
         liftIO $ setCurrentDirectory pwd
         writeFile' out ""
 
@@ -58,6 +63,7 @@
 
     crash ["changedir"] ["current directory has changed"]
     build ["cdir.1","cdir.2","-j1"]
-    crash ["--clean","cdir.1","cdir.2","-j2"] ["current directory has changed"]
+    build ["--clean","cdir.1","pause.2","-j1"]
+    crash ["--clean","cdir.1","pause.2","-j2"] ["current directory has changed"]
     crash ["existance"] ["changed since being built"]
     crash ["createtwice"] ["changed since being built"]
diff --git a/Examples/Test/Makefile.hs b/Examples/Test/Makefile.hs
--- a/Examples/Test/Makefile.hs
+++ b/Examples/Test/Makefile.hs
@@ -3,7 +3,7 @@
 
 import Development.Shake(action, liftIO)
 import Development.Shake.FilePath
-import qualified Development.Make.Main as Makefile
+import qualified Start as Makefile
 import System.Environment
 import System.Directory
 import Examples.Util
@@ -14,7 +14,9 @@
 
 main = shaken test $ \args obj ->
     action $ liftIO $ do
-        withArgs [fromMaybe x $ stripPrefix "@" x | x <- args] Makefile.main
+        unless (["@@"] `isPrefixOf` args) $
+            error "The 'makefile' example should only be used in test mode, to test using a makefile use the 'make' example."
+        withArgs [fromMaybe x $ stripPrefix "@" x | x <- drop 1 args] Makefile.main
 
 
 test build obj = do
@@ -26,6 +28,6 @@
                     copyFile (from </> x) (obj to </> x)
 
     copyTo "Examples/MakeTutor" "MakeTutor"
-    build ["--directory=" ++ obj "MakeTutor","--no-report"]
-    build ["--directory=" ++ obj "MakeTutor","--no-report"]
-    build ["--directory=" ++ obj "MakeTutor","@clean","--no-report"]
+    build ["@@","--directory=" ++ obj "MakeTutor","--no-report"]
+    build ["@@","--directory=" ++ obj "MakeTutor","--no-report"]
+    build ["@@","--directory=" ++ obj "MakeTutor","@clean","--no-report"]
diff --git a/Examples/Test/Resources.hs b/Examples/Test/Resources.hs
--- a/Examples/Test/Resources.hs
+++ b/Examples/Test/Resources.hs
@@ -14,6 +14,8 @@
     flip (shaken test) extra $ \args obj -> do
         want $ map obj ["file1.txt","file2.txt","file3.txt","file4.txt"]
         res <- newResource "test" cap
+        res2 <- newResource "test" cap
+        unless (res < res2 || res2 < res) $ error "Resources should have a good ordering"
         obj "*.txt" *> \out ->
             withResource res 1 $ do
                 old <- liftIO $ atomicModifyIORef ref $ \i -> (i+1,i)
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Neil Mitchell 2011-2012.
+Copyright Neil Mitchell 2011-2013.
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -1,4 +1,4 @@
 
 module Main(main) where
 
-import Development.Make.Main(main)
+import Start
diff --git a/Paths.hs b/Paths.hs
--- a/Paths.hs
+++ b/Paths.hs
@@ -3,9 +3,20 @@
 module Paths_shake where
 
 import Data.Version
+import System.IO.Unsafe
+import System.Directory
+import Control.Exception
 
+
+-- We want getDataFileName to be relative to the current directory even if
+-- we issue a change directory command. Therefore, first call caches, future ones read.
+curdir :: String
+curdir = unsafePerformIO getCurrentDirectory
+
 getDataFileName :: FilePath -> IO FilePath
-getDataFileName x = return $ "./" ++ x
+getDataFileName x = do
+    evaluate curdir
+    return $ curdir ++ "/" ++ x
 
 version :: Version
 version = Version {versionBranch = [0,0], versionTags = []}
diff --git a/Start.hs b/Start.hs
new file mode 100644
--- /dev/null
+++ b/Start.hs
@@ -0,0 +1,42 @@
+
+module Start(main) where
+
+import Development.Make.All
+import Development.Ninja.All
+import System.Environment
+import Development.Shake
+import Development.Shake.FilePath
+import Development.Shake.Timing
+import qualified System.Directory as IO
+import System.Console.GetOpt
+
+
+main :: IO ()
+main = do
+    resetTimings
+    args <- getArgs
+    withArgs ("--no-time":args) $
+        shakeArgsWith shakeOptions flags $ \opts targets -> do
+            makefile <- case reverse [x | UseMakefile x <- opts] of
+                x:_ -> return x
+                _ -> findMakefile
+            if takeExtension makefile == ".ninja" then
+                fmap Just $ runNinja makefile targets
+             else
+                fmap Just $ runMakefile makefile targets
+
+
+data Flag = UseMakefile FilePath
+
+flags = [Option "f" ["file","makefile"] (ReqArg (Right . UseMakefile) "FILE") "Read FILE as a makefile."]
+
+
+findMakefile :: IO FilePath
+findMakefile = do
+    b <- IO.doesFileExist "makefile"
+    if b then return "makefile" else do
+        b <- IO.doesFileExist "Makefile"
+        if b then return "Makefile" else do
+            b <- IO.doesFileExist "build.ninja"
+            if b then return "build.ninja" else
+                error "Could not find `makefile', `Makefile' or `build.ninja'"
diff --git a/Test.hs b/Test.hs
--- a/Test.hs
+++ b/Test.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module Main(main) where
 
@@ -7,8 +8,12 @@
 import Data.Maybe
 import System.Environment
 import Development.Shake.Pool
-
+import Development.Shake.Timing
+import Development.Shake.FileTime
+import qualified Data.ByteString.Char8 as BS
 import Examples.Util(sleepFileTime)
+import Control.Concurrent
+
 import qualified Examples.Tar.Main as Tar
 import qualified Examples.Self.Main as Self
 import qualified Examples.C.Main as C
@@ -32,10 +37,10 @@
 import qualified Examples.Test.Random as Random
 import qualified Examples.Test.Resources as Resources
 
-import qualified Development.Make.Main as Make
+import qualified Start as Start
 
 
-fakes = ["clean" * clean, "test" * test, "make" * makefile]
+fakes = ["clean" * clean, "test" * test, "make" * makefile, "filetime" * filetime]
     where (*) = (,)
 
 mains = ["tar" * Tar.main, "self" * Self.main, "c" * C.main
@@ -51,7 +56,13 @@
 
 main :: IO ()
 main = do
+    resetTimings
     xs <- getArgs
+#if __GLASGOW_HASKELL__ >= 706
+    exePath <- getExecutablePath
+#else
+    exePath <- getProgName
+#endif
     case flip lookup (fakes ++ mains) =<< listToMaybe xs of
         Nothing -> putStrLn $ unlines
             ["Welcome to the Shake demo"
@@ -61,7 +72,7 @@
             ,""
             ,"As an example, try:"
             ,""
-            ,"  main self --threads2 --loud"
+            ,unwords ["  ", exePath, "self",  "--jobs=2", "--trace"]
             ,""
             ,"Which will build Shake, using Shake, on 2 threads."]
         Just main -> main sleepFileTime
@@ -70,7 +81,29 @@
 makefile :: IO () -> IO ()
 makefile _ = do
     args <- getArgs
-    withArgs (drop 1 args) Make.main
+    withArgs (drop 1 args) Start.main
+
+
+filetime :: IO () -> IO ()
+filetime _ = do
+    args <- getArgs
+    addTiming "Reading files"
+    files <- fmap concat $ forM (drop 1 args) $ \file ->
+        fmap (BS.lines . BS.filter (/= '\r')) $ BS.readFile file
+    let n = length files
+    evaluate n
+    addTiming "Modtime"
+    let (a,bcd) = splitAt (n `div` 4) files
+    let (b,cd) = splitAt (n `div` 4) bcd
+    let (c,d) = splitAt (n `div` 4) cd
+    vars <- forM [a,b,c,d] $ \xs -> do
+        mvar <- newEmptyMVar
+        forkIO $ do
+            mapM_ getModTimeMaybe xs
+            putMVar mvar ()
+        return $ takeMVar mvar
+    sequence_ vars
+    printTimings
 
 
 clean :: IO () -> IO ()
diff --git a/shake.cabal b/shake.cabal
--- a/shake.cabal
+++ b/shake.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.8
 build-type:         Simple
 name:               shake
-version:            0.10.3
+version:            0.10.4
 license:            BSD3
 license-file:       LICENSE
 category:           Development
@@ -121,7 +121,9 @@
         Development.Shake.Report
         Development.Shake.Rerun
         Development.Shake.Shake
+        Development.Shake.Special
         Development.Shake.Storage
+        Development.Shake.Timing
         Development.Shake.Types
         Development.Shake.Value
         Paths_shake
@@ -129,6 +131,7 @@
 
 executable shake
     main-is: Main.hs
+    ghc-options: -threaded
     build-depends:
         base == 4.*,
         old-time,
@@ -151,11 +154,15 @@
             build-depends: unix >= 2.5.1
 
     other-modules:
+        Development.Make.All
         Development.Make.Env
-        Development.Make.Main
         Development.Make.Parse
         Development.Make.Rules
         Development.Make.Type
+        Development.Ninja.All
+        Development.Ninja.Parse
+        Development.Ninja.Type
+        Start
 
 
 executable shake-test
@@ -164,6 +171,7 @@
         buildable: True
     else
         buildable: False
+    ghc-options: -threaded
     build-depends:
         base == 4.*,
         old-time,
@@ -186,11 +194,14 @@
             build-depends: unix >= 2.5.1
 
     other-modules:
+        Development.Make.All
         Development.Make.Env
-        Development.Make.Main
         Development.Make.Parse
         Development.Make.Rules
         Development.Make.Type
+        Development.Ninja.All
+        Development.Ninja.Parse
+        Development.Ninja.Type
         Examples.Util
         Examples.C.Main
         Examples.Self.Main
@@ -214,3 +225,4 @@
         Examples.Test.Progress
         Examples.Test.Random
         Examples.Test.Resources
+        Start
