diff --git a/Network/Wai/Middleware/RequestLogger.hs b/Network/Wai/Middleware/RequestLogger.hs
--- a/Network/Wai/Middleware/RequestLogger.hs
+++ b/Network/Wai/Middleware/RequestLogger.hs
@@ -82,7 +82,9 @@
     callback <-
         case destination of
             Handle h -> return $ BS.hPutStr h . logToByteString
-            Logger l -> return $ pushLogStr l
+            Logger l -> return $ \msg -> do
+                pushLogStr l msg
+                flushLogStr l
             Callback c -> return c
     case outputFormat of
         Apache ipsrc -> do
@@ -177,13 +179,14 @@
                     return $ ansiColor color
             else return (return return)
     return $ detailedMiddleware' cb getAddColor
-  where
-    ansiColor color bs = [
-        pack $ setSGRCode [SetColor Foreground Vivid color]
-      , bs
-      , pack $ setSGRCode [Reset]
-      ]
 
+ansiColor :: Color -> BS.ByteString -> [BS.ByteString]
+ansiColor color bs = [
+    pack $ setSGRCode [SetColor Foreground Vivid color]
+  , bs
+  , pack $ setSGRCode [Reset]
+  ]
+
 detailedMiddleware' :: Callback
                     -> IO (BS.ByteString -> [BS.ByteString])
                     -> Middleware
@@ -225,14 +228,14 @@
     let getParams = map emptyGetParam $ queryString req
 
     addColor <- getAddColor
+    let accept = fromMaybe "" $ lookup "Accept" $ requestHeaders req
 
     -- log the request immediately.
     liftIO $ cb $ mconcat $ map toLogStr $ addColor (requestMethod req) ++
         [ " "
         , rawPathInfo req
-        , "\n"
-        , "Accept: "
-        , fromMaybe "" $ lookup "Accept" $ requestHeaders req
+        , " | "
+        , accept
         , paramsToBS  "GET " getParams
         , paramsToBS "POST " postParams
         , "\n"
@@ -243,14 +246,14 @@
     -- log the status of the response
     -- this is color coordinated with the request logging
     -- also includes the request path to connect it to the request
-    liftIO $ cb $ mconcat $ map toLogStr $ addColor "Status: " ++ [
-          statusBS rsp
-        , " "
+    liftIO $ cb $ mconcat $ map toLogStr $
+        addColor "Status: " ++ statusBS rsp ++
+        [ " "
         , msgBS rsp
         , ". "
         , rawPathInfo req -- if you need help matching the 2 logging statements
         , "\n"
-      ]
+        ]
     return rsp
   where
     paramsToBS prefix params =
@@ -275,8 +278,12 @@
             (i, _):_ -> Just (i :: Int)
             [] -> Nothing
 
-statusBS :: Response -> BS.ByteString
-statusBS = pack . show . statusCode . responseStatus
+statusBS :: Response -> [BS.ByteString]
+statusBS rsp =
+    if status > 400 then ansiColor Red bs else [bs]
+  where
+    bs = pack $ show status
+    status = statusCode $ responseStatus rsp
 
 msgBS :: Response -> BS.ByteString
 msgBS = statusMessage . responseStatus
diff --git a/Network/Wai/UrlMap.hs b/Network/Wai/UrlMap.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/UrlMap.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{- | This module gives you a way to mount applications under sub-URIs.
+For example:
+
+> bugsApp, helpdeskApp, apiV1, apiV2, mainApp :: Application
+>
+> myApp :: Application
+> myApp = mapUrls $
+>       mount "bugs"     bugsApp
+>   <|> mount "helpdesk" helpdeskApp
+>   <|> mount "api"
+>           (   mount "v1" apiV1
+>           <|> mount "v2" apiV2
+>           )
+>   <|> mountRoot mainApp
+
+-}
+module Network.Wai.UrlMap (
+    UrlMap',
+    UrlMap,
+    mount',
+    mount,
+    mountRoot,
+    mapUrls
+) where
+
+import Control.Applicative
+import Data.List
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.ByteString as B
+import Network.HTTP.Types
+import Network.Wai
+
+type Path = [Text]
+newtype UrlMap' a = UrlMap' { unUrlMap :: [(Path, a)] }
+
+instance Functor UrlMap' where
+    fmap f (UrlMap' xs) = UrlMap' (fmap (\(p, a) -> (p, f a)) xs)
+
+instance Applicative UrlMap' where
+    pure x                        = UrlMap' [([], x)]
+    (UrlMap' xs) <*> (UrlMap' ys) = UrlMap' [ (p, f y) |
+                                              (p, y) <- ys,
+                                              f <- map snd xs ]
+
+instance Alternative UrlMap' where
+    empty                         = UrlMap' empty
+    (UrlMap' xs) <|> (UrlMap' ys) = UrlMap' (xs <|> ys)
+
+type UrlMap = UrlMap' Application
+
+-- | Mount an application under a given path. The ToApplication typeclass gives
+-- you the option to pass either an 'Network.Wai.Application' or an 'UrlMap'
+-- as the second argument.
+mount' :: ToApplication a => Path -> a -> UrlMap
+mount' prefix thing = UrlMap' [(prefix, toApplication thing)]
+
+-- | A convenience function like mount', but for mounting things under a single
+-- path segment.
+mount :: ToApplication a => Text -> a -> UrlMap
+mount prefix thing = mount' [prefix] thing
+
+-- | Mount something at the root. Use this for the last application in the
+-- block, to avoid 500 errors from none of the applications matching.
+mountRoot :: ToApplication a => a -> UrlMap
+mountRoot = mount' []
+
+try :: Eq a
+    => [a] -- ^ Path info of request
+    -> [([a], b)] -- ^ List of applications to match
+    -> Maybe ([a], b)
+try xs tuples = foldl go Nothing tuples
+    where
+        go (Just x) _ = Just x
+        go _ (prefix, y) = stripPrefix prefix xs >>= \xs' -> return (xs', y)
+
+class ToApplication a where
+    toApplication :: a -> Application
+
+instance ToApplication Application where
+    toApplication = id
+
+instance ToApplication UrlMap where
+    toApplication urlMap = \req ->
+        case try (pathInfo req) (unUrlMap urlMap) of
+            Just (newPath, app) ->
+                app $ req { pathInfo = newPath
+                          , rawPathInfo = makeRaw newPath
+                          }
+            Nothing ->
+                return $ responseLBS
+                    status404
+                    [("content-type", "text/plain")]
+                    "Not found\n"
+
+        where
+        makeRaw :: [Text] -> B.ByteString
+        makeRaw = ("/" `B.append`) . T.encodeUtf8 . T.intercalate "/"
+
+mapUrls :: UrlMap -> Application
+mapUrls = toApplication
diff --git a/test/WaiExtraTest.hs b/test/WaiExtraTest.hs
--- a/test/WaiExtraTest.hs
+++ b/test/WaiExtraTest.hs
@@ -9,6 +9,7 @@
 import Network.Wai
 import Network.Wai.Test
 import Network.Wai.Parse
+import Network.Wai.UrlMap
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy.Char8 as L8
@@ -17,6 +18,7 @@
 import qualified Data.Text as TS
 import qualified Data.Text.Encoding as TE
 import Control.Arrow
+import Control.Applicative
 import Control.Monad.Trans.Resource (getInternalState, withInternalState, runResourceT)
 
 import Network.Wai.Middleware.Jsonp
@@ -42,6 +44,9 @@
 
 specs :: Spec
 specs = do
+  describe "Network.Wai.UrlMap" $ do
+    mapM_ (uncurry it) casesUrlMap
+
   describe "Network.Wai.Parse" $ do
     describe "parseContentType" $ do
         let go (x, y, z) = it (TS.unpack $ TE.decodeUtf8 x) $ parseContentType x `shouldBe` (y, z)
@@ -541,8 +546,8 @@
   where
     params = [("foo", "bar"), ("baz", "bin")]
     -- FIXME change back once we include post parameter output in logging postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)
-    postOutput = T.pack $ "POST /\nAccept: \nStatus: 200 OK. /\n"
-    getOutput params' = T.pack $ "GET /location\nAccept: \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
+    postOutput = T.pack $ "POST / | \nStatus: 200 OK. /\n"
+    getOutput params' = T.pack $ "GET /location | \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
 
     debugApp output' req = do
         iactual <- liftIO $ I.newIORef mempty
@@ -561,3 +566,63 @@
 
     {-debugApp = debug $ \req -> do-}
         {-return $ responseLBS status200 [ ] ""-}
+
+urlMapTestApp :: Application
+urlMapTestApp = mapUrls $
+        mount "bugs"     bugsApp
+    <|> mount "helpdesk" helpdeskApp
+    <|> mount "api"
+            (   mount "v1" apiV1
+            <|> mount "v2" apiV2
+            )
+    <|> mountRoot mainApp
+
+  where
+  trivialApp :: S.ByteString -> Application
+  trivialApp name req =
+    return $
+      responseLBS
+        status200
+        [ ("content-type", "text/plain")
+        , ("X-pathInfo",    S8.pack . show . pathInfo $ req)
+        , ("X-rawPathInfo", rawPathInfo req)
+        , ("X-appName",     name)
+        ]
+        ""
+
+  bugsApp     = trivialApp "bugs"
+  helpdeskApp = trivialApp "helpdesk"
+  apiV1       = trivialApp "apiv1"
+  apiV2       = trivialApp "apiv2"
+  mainApp     = trivialApp "main"
+
+casesUrlMap :: [(String, Assertion)]
+casesUrlMap = [pair1, pair2, pair3, pair4]
+  where
+  makePair name session = (name, runSession session urlMapTestApp)
+  get reqPath = request $ setPath defaultRequest reqPath
+  s = S8.pack . show :: [TS.Text] -> S.ByteString
+
+  pair1 = makePair "should mount root" $ do
+    res1 <- get "/"
+    assertStatus 200 res1
+    assertHeader "X-rawPathInfo" "/"    res1
+    assertHeader "X-pathInfo"    (s []) res1
+    assertHeader "X-appName"     "main" res1
+
+  pair2 = makePair "should mount apps" $ do
+    res2 <- get "/bugs"
+    assertStatus 200 res2
+    assertHeader "X-rawPathInfo" "/"    res2
+    assertHeader "X-pathInfo"    (s []) res2
+    assertHeader "X-appName"     "bugs" res2
+
+  pair3 = makePair "should preserve extra path info" $ do
+    res3 <- get "/helpdesk/issues/11"
+    assertStatus 200 res3
+    assertHeader "X-rawPathInfo" "/issues/11"         res3
+    assertHeader "X-pathInfo"    (s ["issues", "11"]) res3
+
+  pair4 = makePair "should 404 if none match" $ do
+    res4 <- get "/api/v3"
+    assertStatus 404 res4
diff --git a/wai-extra.cabal b/wai-extra.cabal
--- a/wai-extra.cabal
+++ b/wai-extra.cabal
@@ -1,5 +1,5 @@
 Name:                wai-extra
-Version:             2.0.1.2
+Version:             2.0.2
 Synopsis:            Provides some basic WAI handlers and middleware.
 Description:         The goal here is to provide common features without many dependencies.
 License:             MIT
@@ -60,6 +60,7 @@
                      Network.Wai.Middleware.Vhost
                      Network.Wai.Middleware.HttpAuth
                      Network.Wai.Parse
+                     Network.Wai.UrlMap
   other-modules:     Network.Wai.Middleware.RequestLogger.Internal
   ghc-options:       -Wall