diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/servant-examples/auth-combinator/auth-combinator.hs
index c6373fe1..d1a11439 100644
--- a/servant-examples/auth-combinator/auth-combinator.hs
+++ b/servant-examples/auth-combinator/auth-combinator.hs
@@ -28,14 +28,15 @@ data AuthProtected
 instance HasServer rest => HasServer (AuthProtected :> rest) where
   type ServerT (AuthProtected :> rest) m = ServerT rest m
 
-  route Proxy a request respond =
-    case lookup "Cookie" (requestHeaders request) of
-      Nothing -> respond . succeedWith $ responseLBS status401 [] "Missing auth header."
-      Just v  -> do
-        authGranted <- isGoodCookie v
-        if authGranted
-          then route (Proxy :: Proxy rest) a request respond
-          else respond . succeedWith $ responseLBS status403 [] "Invalid cookie."
+  route Proxy a = WithRequest $ \ request ->
+    route (Proxy :: Proxy rest) $ do
+      case lookup "Cookie" (requestHeaders request) of
+        Nothing -> return $ failWith $ HttpError status401 (Just "Missing auth header.")
+        Just v  -> do
+          authGranted <- isGoodCookie v
+          if authGranted
+            then a
+            else return $ failWith $ HttpError status403 (Just "Invalid cookie.")
 
 type PrivateAPI = Get '[JSON] [PrivateData]
 
diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal
index 0bfba00a..26ee185d 100644
--- a/servant-server/servant-server.cabal
+++ b/servant-server/servant-server.cabal
@@ -35,14 +35,18 @@ library
     Servant
     Servant.Server
     Servant.Server.Internal
-    Servant.Server.Internal.ServantErr
     Servant.Server.Internal.Enter
+    Servant.Server.Internal.PathInfo
+    Servant.Server.Internal.Router
+    Servant.Server.Internal.RoutingApplication
+    Servant.Server.Internal.ServantErr
     Servant.Utils.StaticFiles
   build-depends:
         base               >= 4.7  && < 5
       , aeson              >= 0.7  && < 0.10
       , attoparsec         >= 0.12 && < 0.14
       , bytestring         >= 0.10 && < 0.11
+      , containers         >= 0.5  && < 0.6
       , either             >= 4.3  && < 4.5
       , http-types         >= 0.8  && < 0.9
       , network-uri        >= 2.6  && < 2.7
diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs
index 6e28d99e..fcf02f1a 100644
--- a/servant-server/src/Servant/Server.hs
+++ b/servant-server/src/Servant/Server.hs
@@ -81,7 +81,6 @@ import           Data.Proxy                         (Proxy)
 import           Network.Wai                        (Application)
 import           Servant.Server.Internal
 import           Servant.Server.Internal.Enter
-import           Servant.Server.Internal.ServantErr
 
 
 -- * Implementing Servers
@@ -108,7 +107,7 @@ import           Servant.Server.Internal.ServantErr
 -- > main = Network.Wai.Handler.Warp.run 8080 app
 --
 serve :: HasServer layout => Proxy layout -> Server layout -> Application
-serve p server = toApplication (route p server)
+serve p server = toApplication (runRouter (route p (return (RR (Right server)))))
 
 
 -- Documentation
diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index e3282624..02c729f3 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE PolyKinds            #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
@@ -11,17 +12,20 @@
 {-# LANGUAGE OverlappingInstances #-}
 #endif
 
-module Servant.Server.Internal where
+module Servant.Server.Internal
+  ( module Servant.Server.Internal
+  , module Servant.Server.Internal.PathInfo
+  , module Servant.Server.Internal.Router
+  , module Servant.Server.Internal.RoutingApplication
+  , module Servant.Server.Internal.ServantErr
+  ) where
 
 #if !MIN_VERSION_base(4,8,0)
 import           Control.Applicative         ((<$>))
-import           Data.Monoid                 (Monoid, mappend, mempty)
 #endif
-import           Control.Monad.Trans.Either  (EitherT, runEitherT)
+import           Control.Monad.Trans.Either  (EitherT)
 import qualified Data.ByteString             as B
-import qualified Data.ByteString.Lazy        as BL
-import           Data.IORef                  (newIORef, readIORef, writeIORef)
-import           Data.List                   (unfoldr)
+import qualified Data.Map                    as M
 import           Data.Maybe                  (catMaybes, fromMaybe)
 import           Data.String                 (fromString)
 import           Data.String.Conversions     (cs, (<>))
@@ -31,12 +35,9 @@ import           Data.Text.Encoding          (decodeUtf8, encodeUtf8)
 import           Data.Typeable
 import           GHC.TypeLits                (KnownSymbol, symbolVal)
 import           Network.HTTP.Types          hiding (Header, ResponseHeaders)
-import           Network.Wai                 (Application, Request, Response,
-                                              ResponseReceived, lazyRequestBody,
-                                              pathInfo, rawQueryString,
-                                              requestBody, requestHeaders,
-                                              requestMethod, responseLBS,
-                                              strictRequestBody)
+import           Network.Wai                 (Application, lazyRequestBody,
+                                              rawQueryString, requestHeaders,
+                                              requestMethod, responseLBS)
 import           Servant.API                 ((:<|>) (..), (:>), Capture,
                                                Delete, Get, Header,
                                               MatrixFlag, MatrixParam, MatrixParams,
@@ -50,136 +51,15 @@ import           Servant.API.ResponseHeaders (Headers, getResponse, GetHeaders,
                                               getHeaders)
 import           Servant.Common.Text         (FromText, fromText)
 
+import           Servant.Server.Internal.PathInfo
+import           Servant.Server.Internal.Router
+import           Servant.Server.Internal.RoutingApplication
 import           Servant.Server.Internal.ServantErr
 
-data ReqBodyState = Uncalled
-                  | Called !B.ByteString
-                  | Done !B.ByteString
-
-
-toApplication :: RoutingApplication -> Application
-toApplication ra request respond = do
-  reqBodyRef <- newIORef Uncalled
-  -- We may need to consume the requestBody more than once.  In order to
-  -- maintain the illusion that 'requestBody' works as expected,
-  -- 'ReqBodyState' is introduced, and the complete body is memoized and
-  -- returned as many times as requested with empty "Done" marker chunks in
-  -- between.
-  -- See https://github.com/haskell-servant/servant/issues/3
-  let memoReqBody = do
-          ior <- readIORef reqBodyRef
-          case ior of
-            Uncalled -> do
-                r <- BL.toStrict <$> strictRequestBody request
-                writeIORef reqBodyRef $ Done r
-                return r
-            Called bs -> do
-                writeIORef reqBodyRef $ Done bs
-                return bs
-            Done bs -> do
-                writeIORef reqBodyRef $ Called bs
-                return B.empty
-
-  ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
- where
-  routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
-  routingRespond (Left NotFound) =
-    respond $ responseLBS notFound404 [] "not found"
-  routingRespond (Left WrongMethod) =
-    respond $ responseLBS methodNotAllowed405 [] "method not allowed"
-  routingRespond (Left (InvalidBody err)) =
-    respond $ responseLBS badRequest400 [] $ fromString $ "invalid request body: " ++ err
-  routingRespond (Left UnsupportedMediaType) =
-    respond $ responseLBS unsupportedMediaType415 [] "unsupported media type"
-  routingRespond (Left (HttpError status body)) =
-    respond $ responseLBS status [] $ fromMaybe (BL.fromStrict $ statusMessage status) body
-  routingRespond (Right response) =
-    respond response
-
--- Note that the ordering of the constructors has great significance! It
--- determines the Ord instance and, consequently, the monoid instance.
--- * Route mismatch
-data RouteMismatch =
-    NotFound           -- ^ the usual "not found" error
-  | WrongMethod        -- ^ a more informative "you just got the HTTP method wrong" error
-  | UnsupportedMediaType -- ^ request body has unsupported media type
-  | InvalidBody String -- ^ an even more informative "your json request body wasn't valid" error
-  | HttpError Status (Maybe BL.ByteString)  -- ^ an even even more informative arbitrary HTTP response code error.
-  deriving (Eq, Ord, Show)
-
-instance Monoid RouteMismatch where
-  mempty = NotFound
-  -- The following isn't great, since it picks @InvalidBody@ based on
-  -- alphabetical ordering, but any choice would be arbitrary.
-  --
-  -- "As one judge said to the other, 'Be just and if you can't be just, be
-  -- arbitrary'" -- William Burroughs
-  mappend = max
-
-
--- | A wrapper around @'Either' 'RouteMismatch' a@.
-newtype RouteResult a =
-  RR { routeResult :: Either RouteMismatch a }
-  deriving (Eq, Show)
-
-failWith :: RouteMismatch -> RouteResult a
-failWith = RR . Left
-
-succeedWith :: a -> RouteResult a
-succeedWith = RR . Right
-
-isMismatch :: RouteResult a -> Bool
-isMismatch (RR (Left _)) = True
-isMismatch _             = False
-
--- | Like `null . pathInfo`, but works with redundant trailing slashes.
-pathIsEmpty :: Request -> Bool
-pathIsEmpty = f . processedPathInfo
-  where
-    f []   = True
-    f [""] = True
-    f _    = False
-
--- | If we get a `Right`, it has precedence over everything else.
---
--- This in particular means that if we could get several 'Right's,
--- only the first we encounter would be taken into account.
-instance Monoid (RouteResult a) where
-  mempty = RR $ Left mempty
-
-  RR (Left x)  `mappend` RR (Left y)  = RR $ Left (x <> y)
-  RR (Left _)  `mappend` RR (Right y) = RR $ Right y
-  r            `mappend` _            = r
-
-type RoutingApplication =
-     Request -- ^ the request, the field 'pathInfo' may be modified by url routing
-  -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
-
-splitMatrixParameters :: Text -> (Text, Text)
-splitMatrixParameters = T.break (== ';')
-
-parsePathInfo :: Request -> [Text]
-parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
-  where mergePairs = concat . unfoldr pairToList
-        pairToList []          = Nothing
-        pairToList ((a, b):xs) = Just ([a, b], xs)
-
--- | Returns a processed pathInfo from the request.
---
--- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
--- processed, so routing works as intended. Therefor this function should be used to access
--- the pathInfo for routing purposes.
-processedPathInfo :: Request -> [Text]
-processedPathInfo r =
-  case pinfo of
-    (x:xs) | T.head x == ';' -> xs
-    _                        -> pinfo
-  where pinfo = parsePathInfo r
-
 class HasServer layout where
   type ServerT layout (m :: * -> *) :: *
 
-  route :: Proxy layout -> Server layout -> RoutingApplication
+  route :: Proxy layout -> IO (RouteResult (Server layout)) -> Router
 
 type Server layout = ServerT layout (EitherT ServantErr IO)
 
@@ -200,12 +80,8 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
 
   type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
 
-  route Proxy (a :<|> b) request respond =
-    route pa a request $ \mResponse ->
-      if isMismatch mResponse
-        then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
-        else respond mResponse
-
+  route Proxy server = choice (route pa (extractL <$> server))
+                              (route pb (extractR <$> server))
     where pa = Proxy :: Proxy a
           pb = Proxy :: Proxy b
 
@@ -235,18 +111,65 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
   type ServerT (Capture capture a :> sublayout) m =
      a -> ServerT sublayout m
 
-  route Proxy subserver request respond = case processedPathInfo request of
-    (first : rest)
-      -> case captured captureProxy first of
-           Nothing  -> respond $ failWith NotFound
-           Just v   -> route (Proxy :: Proxy sublayout) (subserver v) request{
-                         pathInfo = rest
-                       } respond
-    _ -> respond $ failWith NotFound
-
+  route Proxy subserver =
+    DynamicRouter $ \ first ->
+      route (Proxy :: Proxy sublayout)
+            (case captured captureProxy first of
+               Nothing  -> return $ failWith NotFound
+               Just v   -> feedTo subserver v)
     where captureProxy = Proxy :: Proxy (Capture capture a)
 
 
+methodRouter :: (AllCTRender ctypes a)
+             => Method -> Proxy ctypes -> Status
+             -> IO (RouteResult (EitherT ServantErr IO a))
+             -> Router
+methodRouter method proxy status action = LeafRouter route'
+  where
+    route' request respond
+      | pathIsEmpty request && requestMethod request == method = do
+          runAction action respond $ \ output -> do
+            let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
+            case handleAcceptH proxy (AcceptHeader accH) output of
+              Nothing -> failWith UnsupportedMediaType
+              Just (contentT, body) -> succeedWith $
+                responseLBS status [ ("Content-Type" , cs contentT)] body
+      | pathIsEmpty request && requestMethod request /= method =
+          respond $ failWith WrongMethod
+      | otherwise = respond $ failWith NotFound
+
+methodRouterHeaders :: (GetHeaders (Headers h v), AllCTRender ctypes v)
+                    => Method -> Proxy ctypes -> Status
+                    -> IO (RouteResult (EitherT ServantErr IO (Headers h v)))
+                    -> Router
+methodRouterHeaders method proxy status action = LeafRouter route'
+  where
+    route' request respond
+      | pathIsEmpty request && requestMethod request == method = do
+        runAction action respond $ \ output -> do
+          let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
+              headers = getHeaders output
+          case handleAcceptH proxy (AcceptHeader accH) (getResponse output) of
+            Nothing -> failWith UnsupportedMediaType
+            Just (contentT, body) -> succeedWith $
+              responseLBS status ( ("Content-Type" , cs contentT) : headers) body
+      | pathIsEmpty request && requestMethod request /= method =
+          respond $ failWith WrongMethod
+      | otherwise = respond $ failWith NotFound
+
+methodRouterEmpty :: Method
+                  -> IO (RouteResult (EitherT ServantErr IO ()))
+                  -> Router
+methodRouterEmpty method action = LeafRouter route'
+  where
+    route' request respond
+      | pathIsEmpty request && requestMethod request == method = do
+          runAction action respond $ \ () ->
+            succeedWith $ responseLBS noContent204 [] ""
+      | pathIsEmpty request && requestMethod request /= method =
+          respond $ failWith WrongMethod
+      | otherwise = respond $ failWith NotFound
+
 -- | If you have a 'Delete' endpoint in your API,
 -- the handler for this endpoint is meant to delete
 -- a resource.
@@ -267,20 +190,7 @@ instance
 
   type ServerT (Delete ctypes a) m = m a
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodDelete = do
-        e <- runEitherT action
-        respond $ case e of
-          Right output -> do
-            let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-            case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
-              Nothing -> failWith UnsupportedMediaType
-              Just (contentT, body) -> succeedWith $
-                responseLBS status200 [ ("Content-Type" , cs contentT)] body
-          Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodDelete =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200
 
 instance
 #if MIN_VERSION_base(4,8,0)
@@ -290,15 +200,7 @@ instance
 
   type ServerT (Delete ctypes ()) m = m ()
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodDelete = do
-        e <- runEitherT action
-        respond . succeedWith $ case e of
-          Right () -> responseLBS noContent204 [] ""
-          Left err -> responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodDelete =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterEmpty methodDelete
 
 -- Add response headers
 instance
@@ -310,21 +212,7 @@ instance
 
   type ServerT (Delete ctypes (Headers h v)) m = m (Headers h v)
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodDelete = do
-      e <- runEitherT action
-      respond $ case e of
-        Right output -> do
-          let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-              headers = getHeaders output
-          case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
-            Nothing -> failWith UnsupportedMediaType
-            Just (contentT, body) -> succeedWith $
-              responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
-        Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodDelete =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterHeaders methodDelete (Proxy :: Proxy ctypes) ok200
 
 -- | When implementing the handler for a 'Get' endpoint,
 -- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'
@@ -347,20 +235,7 @@ instance
 
   type ServerT (Get ctypes a) m = m a
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodGet = do
-        e <- runEitherT action
-        respond $ case e of
-          Right output -> do
-            let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-            case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
-              Nothing -> failWith UnsupportedMediaType
-              Just (contentT, body) -> succeedWith $
-                responseLBS ok200 [ ("Content-Type" , cs contentT)] body
-          Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodGet =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200
 
 -- '()' ==> 204 No Content
 instance
@@ -371,15 +246,7 @@ instance
 
   type ServerT (Get ctypes ()) m = m ()
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodGet = do
-        e <- runEitherT action
-        respond . succeedWith $ case e of
-          Right () -> responseLBS noContent204 [] ""
-          Left err -> responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodGet =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterEmpty methodGet
 
 -- Add response headers
 instance
@@ -391,21 +258,7 @@ instance
 
   type ServerT (Get ctypes (Headers h v)) m = m (Headers h v)
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodGet = do
-      e <- runEitherT action
-      respond $ case e of
-        Right output -> do
-          let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-              headers = getHeaders output
-          case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
-            Nothing -> failWith UnsupportedMediaType
-            Just (contentT, body) -> succeedWith $
-              responseLBS ok200 ( ("Content-Type" , cs contentT) : headers) body
-        Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodGet =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterHeaders methodGet (Proxy :: Proxy ctypes) ok200
 
 -- | If you use 'Header' in one of the endpoints for your API,
 -- this automatically requires your server-side handler to be a function
@@ -433,11 +286,10 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
   type ServerT (Header sym a :> sublayout) m =
     Maybe a -> ServerT sublayout m
 
-  route Proxy subserver request respond = do
+  route Proxy subserver = WithRequest $ \ request ->
     let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
-    route (Proxy :: Proxy sublayout) (subserver mheader) request respond
-
-      where str = fromString $ symbolVal (Proxy :: Proxy sym)
+    in  route (Proxy :: Proxy sublayout) (feedTo subserver mheader)
+    where str = fromString $ symbolVal (Proxy :: Proxy sym)
 
 -- | When implementing the handler for a 'Post' endpoint,
 -- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
@@ -461,20 +313,7 @@ instance
 
   type ServerT (Post ctypes a) m = m a
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPost = do
-        e <- runEitherT action
-        respond $ case e of
-          Right output -> do
-            let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-            case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
-              Nothing -> failWith UnsupportedMediaType
-              Just (contentT, body) -> succeedWith $
-                responseLBS status201 [ ("Content-Type" , cs contentT)] body
-          Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPost =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201
 
 instance
 #if MIN_VERSION_base(4,8,0)
@@ -484,15 +323,7 @@ instance
 
   type ServerT (Post ctypes ()) m = m ()
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPost = do
-        e <- runEitherT action
-        respond . succeedWith $ case e of
-          Right () -> responseLBS noContent204 [] ""
-          Left err -> responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPost =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterEmpty methodPost
 
 -- Add response headers
 instance
@@ -504,21 +335,7 @@ instance
 
   type ServerT (Post ctypes (Headers h v)) m = m (Headers h v)
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPost = do
-      e <- runEitherT action
-      respond $ case e of
-        Right output -> do
-          let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-              headers = getHeaders output
-          case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
-            Nothing -> failWith UnsupportedMediaType
-            Just (contentT, body) -> succeedWith $
-              responseLBS status201 ( ("Content-Type" , cs contentT) : headers) body
-        Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPost =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterHeaders methodPost (Proxy :: Proxy ctypes) created201
 
 -- | When implementing the handler for a 'Put' endpoint,
 -- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
@@ -541,20 +358,7 @@ instance
 
   type ServerT (Put ctypes a) m = m a
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPut = do
-        e <- runEitherT action
-        respond $ case e of
-          Right output -> do
-            let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-            case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
-              Nothing -> failWith UnsupportedMediaType
-              Just (contentT, body) -> succeedWith $
-                responseLBS status200 [ ("Content-Type" , cs contentT)] body
-          Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPut =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200
 
 instance
 #if MIN_VERSION_base(4,8,0)
@@ -564,15 +368,7 @@ instance
 
   type ServerT (Put ctypes ()) m = m ()
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPut = do
-        e <- runEitherT action
-        respond . succeedWith $ case e of
-          Right () -> responseLBS noContent204 [] ""
-          Left err -> responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPut =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterEmpty methodPut
 
 -- Add response headers
 instance
@@ -584,21 +380,7 @@ instance
 
   type ServerT (Put ctypes (Headers h v)) m = m (Headers h v)
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPut = do
-      e <- runEitherT action
-      respond $ case e of
-        Right output -> do
-          let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-              headers = getHeaders output
-          case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
-            Nothing -> failWith UnsupportedMediaType
-            Just (contentT, body) -> succeedWith $
-              responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
-        Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPut =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterHeaders methodPut (Proxy :: Proxy ctypes) ok200
 
 -- | When implementing the handler for a 'Patch' endpoint,
 -- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
@@ -619,20 +401,7 @@ instance
 
   type ServerT (Patch ctypes a) m = m a
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPatch = do
-        e <- runEitherT action
-        respond $ case e of
-          Right output -> do
-            let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-            case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
-              Nothing -> failWith UnsupportedMediaType
-              Just (contentT, body) -> succeedWith $
-                responseLBS status200 [ ("Content-Type" , cs contentT)] body
-          Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPatch =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200
 
 instance
 #if MIN_VERSION_base(4,8,0)
@@ -642,15 +411,7 @@ instance
 
   type ServerT (Patch ctypes ()) m = m ()
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPatch = do
-        e <- runEitherT action
-        respond . succeedWith $ case e of
-          Right () -> responseLBS noContent204 [] ""
-          Left err -> responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPatch =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterEmpty methodPatch
 
 -- Add response headers
 instance
@@ -662,21 +423,7 @@ instance
 
   type ServerT (Patch ctypes (Headers h v)) m = m (Headers h v)
 
-  route Proxy action request respond
-    | pathIsEmpty request && requestMethod request == methodPatch = do
-      e <- runEitherT action
-      respond $ case e of
-        Right outpatch -> do
-          let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
-              headers = getHeaders outpatch
-          case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
-            Nothing -> failWith UnsupportedMediaType
-            Just (contentT, body) -> succeedWith $
-              responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
-        Left err -> succeedWith $ responseServantErr err
-    | pathIsEmpty request && requestMethod request /= methodPatch =
-        respond $ failWith WrongMethod
-    | otherwise = respond $ failWith NotFound
+  route Proxy = methodRouterHeaders methodPatch (Proxy :: Proxy ctypes) ok200
 
 -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
 -- this automatically requires your server-side handler to be a function
@@ -705,7 +452,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
   type ServerT (QueryParam sym a :> sublayout) m =
     Maybe a -> ServerT sublayout m
 
-  route Proxy subserver request respond = do
+  route Proxy subserver = WithRequest $ \ request ->
     let querytext = parseQueryText $ rawQueryString request
         param =
           case lookup paramname querytext of
@@ -713,9 +460,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
             Just Nothing  -> Nothing -- param present with no value -> Nothing
             Just (Just v) -> fromText v -- if present, we try to convert to
                                         -- the right type
-
-    route (Proxy :: Proxy sublayout) (subserver param) request respond
-
+    in route (Proxy :: Proxy sublayout) (feedTo subserver param)
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
 
 -- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
@@ -743,16 +488,14 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
   type ServerT (QueryParams sym a :> sublayout) m =
     [a] -> ServerT sublayout m
 
-  route Proxy subserver request respond = do
+  route Proxy subserver = WithRequest $ \ request ->
     let querytext = parseQueryText $ rawQueryString request
         -- if sym is "foo", we look for query string parameters
         -- named "foo" or "foo[]" and call fromText on the
         -- corresponding values
         parameters = filter looksLikeParam querytext
         values = catMaybes $ map (convert . snd) parameters
-
-    route (Proxy :: Proxy sublayout) (subserver values) request respond
-
+    in  route (Proxy :: Proxy sublayout) (feedTo subserver values)
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
           looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
           convert Nothing = Nothing
@@ -776,15 +519,13 @@ instance (KnownSymbol sym, HasServer sublayout)
   type ServerT (QueryFlag sym :> sublayout) m =
     Bool -> ServerT sublayout m
 
-  route Proxy subserver request respond = do
+  route Proxy subserver = WithRequest $ \ request ->
     let querytext = parseQueryText $ rawQueryString request
         param = case lookup paramname querytext of
           Just Nothing  -> True  -- param is there, with no value
           Just (Just v) -> examine v -- param with a value
           Nothing       -> False -- param not in the query string
-
-    route (Proxy :: Proxy sublayout) (subserver param) request respond
-
+    in  route (Proxy :: Proxy sublayout) (feedTo subserver param)
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
           examine v | v == "true" || v == "1" || v == "" = True
                     | otherwise = False
@@ -819,16 +560,17 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
   type ServerT (MatrixParam sym a :> sublayout) m =
     Maybe a -> ServerT sublayout m
 
-  route Proxy subserver request respond = case parsePathInfo request of
-    (first : _)
-      -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
-                param = case lookup paramname querytext of
-                  Nothing       -> Nothing -- param absent from the query string
-                  Just Nothing  -> Nothing -- param present with no value -> Nothing
-                  Just (Just v) -> fromText v -- if present, we try to convert to
-                                        -- the right type
-            route (Proxy :: Proxy sublayout) (subserver param) request respond
-    _ -> route (Proxy :: Proxy sublayout) (subserver Nothing) request respond
+  route Proxy subserver = WithRequest $ \ request ->
+    case parsePathInfo request of
+      (first : _)
+        -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
+                  param = case lookup paramname querytext of
+                    Nothing       -> Nothing -- param absent from the query string
+                    Just Nothing  -> Nothing -- param present with no value -> Nothing
+                    Just (Just v) -> fromText v -- if present, we try to convert to
+                                          -- the right type
+              route (Proxy :: Proxy sublayout) (feedTo subserver param)
+      _   -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing)
 
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
 
@@ -857,16 +599,17 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
   type ServerT (MatrixParams sym a :> sublayout) m =
     [a] -> ServerT sublayout m
 
-  route Proxy subserver request respond = case parsePathInfo request of
-    (first : _)
-      -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
-                -- if sym is "foo", we look for matrix parameters
-                -- named "foo" or "foo[]" and call fromText on the
-                -- corresponding values
-                parameters = filter looksLikeParam matrixtext
-                values = catMaybes $ map (convert . snd) parameters
-            route (Proxy :: Proxy sublayout) (subserver values) request respond
-    _ -> route (Proxy :: Proxy sublayout) (subserver []) request respond
+  route Proxy subserver = WithRequest $ \ request ->
+    case parsePathInfo request of
+      (first : _)
+        -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
+                  -- if sym is "foo", we look for matrix parameters
+                  -- named "foo" or "foo[]" and call fromText on the
+                  -- corresponding values
+                  parameters = filter looksLikeParam matrixtext
+                  values = catMaybes $ map (convert . snd) parameters
+              route (Proxy :: Proxy sublayout) (feedTo subserver values)
+      _ -> route (Proxy :: Proxy sublayout) (feedTo subserver [])
 
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
           looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
@@ -891,17 +634,18 @@ instance (KnownSymbol sym, HasServer sublayout)
   type ServerT (MatrixFlag sym :> sublayout) m =
     Bool -> ServerT sublayout m
 
-  route Proxy subserver request respond =  case parsePathInfo request of
-    (first : _)
-      -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
-                param = case lookup paramname matrixtext of
-                  Just Nothing  -> True  -- param is there, with no value
-                  Just (Just v) -> examine v -- param with a value
-                  Nothing       -> False -- param not in the query string
-
-            route (Proxy :: Proxy sublayout) (subserver param) request respond
-
-    _ -> route (Proxy :: Proxy sublayout) (subserver False) request respond
+  route Proxy subserver = WithRequest $ \ request ->
+    case parsePathInfo request of
+      (first : _)
+        -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
+                  param = case lookup paramname matrixtext of
+                    Just Nothing  -> True  -- param is there, with no value
+                    Just (Just v) -> examine v -- param with a value
+                    Nothing       -> False -- param not in the query string
+  
+              route (Proxy :: Proxy sublayout) (feedTo subserver param)
+  
+      _ -> route (Proxy :: Proxy sublayout) (feedTo subserver False)
 
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
           examine v | v == "true" || v == "1" || v == "" = True
@@ -919,8 +663,11 @@ instance HasServer Raw where
 
   type ServerT Raw m = Application
 
-  route Proxy rawApplication request respond =
-    rawApplication request (respond . succeedWith)
+  route Proxy rawApplication = LeafRouter $ \ request respond -> do
+    r <- rawApplication
+    case r of
+      RR (Left err)  -> respond $ failWith err
+      RR (Right app) -> app request (respond . succeedWith)
 
 -- | If you use 'ReqBody' in one of the endpoints for your API,
 -- this automatically requires your server-side handler to be a function
@@ -948,19 +695,20 @@ instance ( AllCTUnrender list a, HasServer sublayout
   type ServerT (ReqBody list a :> sublayout) m =
     a -> ServerT sublayout m
 
-  route Proxy subserver request respond = do
-    -- See HTTP RFC 2616, section 7.2.1
-    -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
-    -- See also "W3C Internet Media Type registration, consistency of use"
-    -- http://www.w3.org/2001/tag/2002/0129-mime
-    let contentTypeH = fromMaybe "application/octet-stream"
-                     $ lookup hContentType $ requestHeaders request
-    mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
-           <$> lazyRequestBody request
-    case mrqbody of
-      Nothing -> respond . failWith $ UnsupportedMediaType
-      Just (Left e) -> respond . failWith $ InvalidBody e
-      Just (Right v) -> route (Proxy :: Proxy sublayout) (subserver v) request respond
+  route Proxy subserver = WithRequest $ \ request ->
+    route (Proxy :: Proxy sublayout) $ do
+      -- See HTTP RFC 2616, section 7.2.1
+      -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
+      -- See also "W3C Internet Media Type registration, consistency of use"
+      -- http://www.w3.org/2001/tag/2002/0129-mime
+      let contentTypeH = fromMaybe "application/octet-stream"
+                       $ lookup hContentType $ requestHeaders request
+      mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
+             <$> lazyRequestBody request
+      case mrqbody of
+        Nothing -> return $ failWith $ UnsupportedMediaType
+        Just (Left e) -> return $ failWith $ InvalidBody e
+        Just (Right v) -> feedTo subserver v
 
 -- | Make sure the incoming request starts with @"/path"@, strip it and
 -- pass the rest of the request path to @sublayout@.
@@ -968,14 +716,9 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
 
   type ServerT (path :> sublayout) m = ServerT sublayout m
 
-  route Proxy subserver request respond = case processedPathInfo request of
-    (first : rest)
-      | first == cs (symbolVal proxyPath)
-      -> route (Proxy :: Proxy sublayout) subserver request{
-           pathInfo = rest
-         } respond
-    _ -> respond $ failWith NotFound
-
+  route Proxy subserver = StaticRouter $
+    M.singleton (cs (symbolVal proxyPath))
+                (route (Proxy :: Proxy sublayout) subserver)
     where proxyPath = Proxy :: Proxy path
 
 ct_wildcard :: B.ByteString
diff --git a/servant-server/src/Servant/Server/Internal/PathInfo.hs b/servant-server/src/Servant/Server/Internal/PathInfo.hs
new file mode 100644
index 00000000..0138f72e
--- /dev/null
+++ b/servant-server/src/Servant/Server/Internal/PathInfo.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings    #-}
+module Servant.Server.Internal.PathInfo where
+
+import           Data.List                   (unfoldr)
+import           Data.Text                   (Text)
+import qualified Data.Text                   as T
+import           Network.Wai                 (Request, pathInfo)
+
+-- | Like `null . pathInfo`, but works with redundant trailing slashes.
+pathIsEmpty :: Request -> Bool
+pathIsEmpty = f . processedPathInfo
+  where
+    f []   = True
+    f [""] = True
+    f _    = False
+
+
+splitMatrixParameters :: Text -> (Text, Text)
+splitMatrixParameters = T.break (== ';')
+
+parsePathInfo :: Request -> [Text]
+parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
+  where mergePairs = concat . unfoldr pairToList
+        pairToList []          = Nothing
+        pairToList ((a, b):xs) = Just ([a, b], xs)
+
+-- | Returns a processed pathInfo from the request.
+--
+-- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
+-- processed, so routing works as intended. Therefor this function should be used to access
+-- the pathInfo for routing purposes.
+processedPathInfo :: Request -> [Text]
+processedPathInfo r =
+  case pinfo of
+    (x:xs) | T.head x == ';' -> xs
+    _                        -> pinfo
+  where pinfo = parsePathInfo r
+
diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs
new file mode 100644
index 00000000..2e0188e4
--- /dev/null
+++ b/servant-server/src/Servant/Server/Internal/Router.hs
@@ -0,0 +1,72 @@
+module Servant.Server.Internal.Router where
+
+import           Data.Map                    (Map)
+import qualified Data.Map                    as M
+import           Data.Monoid                 ((<>))
+import           Data.Text                   (Text)
+import           Network.Wai                 (Request, pathInfo)
+import           Servant.Server.Internal.PathInfo
+import           Servant.Server.Internal.RoutingApplication
+
+-- | Internal representation of a router.
+data Router =
+    WithRequest   (Request -> Router)
+      -- ^ current request is passed to the router
+  | StaticRouter  (Map Text Router)
+      -- ^ first path component used for lookup and removed afterwards
+  | DynamicRouter (Text -> Router)
+      -- ^ first path component used for lookup and removed afterwards
+  | LeafRouter    RoutingApplication
+      -- ^ to be used for routes that match an empty path
+  | Choice        Router Router
+      -- ^ left-biased choice between two routers
+
+-- | Smart constructor for the choice between routers.
+-- We currently optimize the following cases:
+--
+--   * Two static routers can be joined by joining their maps.
+--   * Two dynamic routers can be joined by joining their codomains.
+--   * Two 'WithRequest' routers can be joined by passing them
+--     the same request and joining their codomains.
+--   * A 'WithRequest' router can be joined with anything else by
+--     passing the same request to both but ignoring it in the
+--     component that does not need it.
+--
+choice :: Router -> Router -> Router
+choice (StaticRouter table1) (StaticRouter table2) =
+  StaticRouter (M.unionWith choice table1 table2)
+choice (DynamicRouter fun1)  (DynamicRouter fun2)  =
+  DynamicRouter (\ first -> choice (fun1 first) (fun2 first))
+choice (WithRequest router1) (WithRequest router2) =
+  WithRequest (\ request -> choice (router1 request) (router2 request))
+choice (WithRequest router1) router2 =
+  WithRequest (\ request -> choice (router1 request) router2)
+choice router1 (WithRequest router2) =
+  WithRequest (\ request -> choice router1 (router2 request))
+choice router1 router2 = Choice router1 router2
+
+-- | Interpret a router as an application.
+runRouter :: Router -> RoutingApplication
+runRouter (WithRequest router) request respond =
+  runRouter (router request) request respond
+runRouter (StaticRouter table) request respond =
+  case processedPathInfo request of
+    first : rest
+      | Just router <- M.lookup first table
+      -> let request' = request { pathInfo = rest }
+         in  runRouter router request' respond
+    _ -> respond $ failWith NotFound
+runRouter (DynamicRouter fun)  request respond =
+  case processedPathInfo request of
+    first : rest
+      -> let request' = request { pathInfo = rest }
+         in  runRouter (fun first) request' respond
+    _ -> respond $ failWith NotFound
+runRouter (LeafRouter app)     request respond = app request respond
+runRouter (Choice r1 r2)       request respond =
+  runRouter r1 request $ \ mResponse1 ->
+    if isMismatch mResponse1
+      then runRouter r2 request $ \ mResponse2 ->
+             respond (mResponse1 <> mResponse2)
+      else respond mResponse1
+
diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs
new file mode 100644
index 00000000..415fff2b
--- /dev/null
+++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TypeOperators              #-}
+module Servant.Server.Internal.RoutingApplication where
+
+#if !MIN_VERSION_base(4,8,0)
+import           Control.Applicative         (Applicative, (<$>))
+import           Data.Monoid                 (Monoid, mappend, mempty)
+#endif
+import           Control.Monad.Trans.Either  (EitherT, runEitherT)
+import qualified Data.ByteString             as B
+import qualified Data.ByteString.Lazy        as BL
+import           Data.IORef                  (newIORef, readIORef, writeIORef)
+import           Data.Maybe                  (fromMaybe)
+import           Data.Monoid                 ((<>))
+import           Data.String                 (fromString)
+import           Network.HTTP.Types          hiding (Header, ResponseHeaders)
+import           Network.Wai                 (Application, Request, Response,
+                                              ResponseReceived,
+                                              requestBody,
+                                              responseLBS,
+                                              strictRequestBody)
+import           Servant.API                 ((:<|>) (..))
+import           Servant.Server.Internal.ServantErr
+
+type RoutingApplication =
+     Request -- ^ the request, the field 'pathInfo' may be modified by url routing
+  -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
+
+-- | A wrapper around @'Either' 'RouteMismatch' a@.
+newtype RouteResult a =
+  RR { routeResult :: Either RouteMismatch a }
+  deriving (Eq, Show, Functor, Applicative)
+
+-- | If we get a `Right`, it has precedence over everything else.
+--
+-- This in particular means that if we could get several 'Right's,
+-- only the first we encounter would be taken into account.
+instance Monoid (RouteResult a) where
+  mempty = RR $ Left mempty
+
+  RR (Left x)  `mappend` RR (Left y)  = RR $ Left (x <> y)
+  RR (Left _)  `mappend` RR (Right y) = RR $ Right y
+  r            `mappend` _            = r
+
+-- Note that the ordering of the constructors has great significance! It
+-- determines the Ord instance and, consequently, the monoid instance.
+data RouteMismatch =
+    NotFound           -- ^ the usual "not found" error
+  | WrongMethod        -- ^ a more informative "you just got the HTTP method wrong" error
+  | UnsupportedMediaType -- ^ request body has unsupported media type
+  | InvalidBody String -- ^ an even more informative "your json request body wasn't valid" error
+  | HttpError Status (Maybe BL.ByteString)  -- ^ an even even more informative arbitrary HTTP response code error.
+  deriving (Eq, Ord, Show)
+
+instance Monoid RouteMismatch where
+  mempty = NotFound
+  -- The following isn't great, since it picks @InvalidBody@ based on
+  -- alphabetical ordering, but any choice would be arbitrary.
+  --
+  -- "As one judge said to the other, 'Be just and if you can't be just, be
+  -- arbitrary'" -- William Burroughs
+  mappend = max
+
+data ReqBodyState = Uncalled
+                  | Called !B.ByteString
+                  | Done !B.ByteString
+
+toApplication :: RoutingApplication -> Application
+toApplication ra request respond = do
+  reqBodyRef <- newIORef Uncalled
+  -- We may need to consume the requestBody more than once.  In order to
+  -- maintain the illusion that 'requestBody' works as expected,
+  -- 'ReqBodyState' is introduced, and the complete body is memoized and
+  -- returned as many times as requested with empty "Done" marker chunks in
+  -- between.
+  -- See https://github.com/haskell-servant/servant/issues/3
+  let memoReqBody = do
+          ior <- readIORef reqBodyRef
+          case ior of
+            Uncalled -> do
+                r <- BL.toStrict <$> strictRequestBody request
+                writeIORef reqBodyRef $ Done r
+                return r
+            Called bs -> do
+                writeIORef reqBodyRef $ Done bs
+                return bs
+            Done bs -> do
+                writeIORef reqBodyRef $ Called bs
+                return B.empty
+
+  ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
+ where
+  routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
+  routingRespond (Left NotFound) =
+    respond $ responseLBS notFound404 [] "not found"
+  routingRespond (Left WrongMethod) =
+    respond $ responseLBS methodNotAllowed405 [] "method not allowed"
+  routingRespond (Left (InvalidBody err)) =
+    respond $ responseLBS badRequest400 [] $ fromString $ "invalid request body: " ++ err
+  routingRespond (Left UnsupportedMediaType) =
+    respond $ responseLBS unsupportedMediaType415 [] "unsupported media type"
+  routingRespond (Left (HttpError status body)) =
+    respond $ responseLBS status [] $ fromMaybe (BL.fromStrict $ statusMessage status) body
+  routingRespond (Right response) =
+    respond response
+
+runAction :: IO (RouteResult (EitherT ServantErr IO a))
+          -> (RouteResult Response -> IO r)
+          -> (a -> RouteResult Response)
+          -> IO r
+runAction action respond k = do
+  r <- action
+  go r
+  where
+    go (RR (Right a))  = do
+      e <- runEitherT a
+      respond $ case e of
+        Right x  -> k x
+        Left err -> succeedWith $ responseServantErr err
+    go (RR (Left err)) = respond $ failWith err
+
+feedTo :: IO (RouteResult (a -> b)) -> a -> IO (RouteResult b)
+feedTo f x = (($ x) <$>) <$> f
+
+extractL :: RouteResult (a :<|> b) -> RouteResult a
+extractL (RR (Right (a :<|> _))) = RR (Right a)
+extractL (RR (Left err))         = RR (Left err)
+
+extractR :: RouteResult (a :<|> b) -> RouteResult b
+extractR (RR (Right (_ :<|> b))) = RR (Right b)
+extractR (RR (Left err))         = RR (Left err)
+
+failWith :: RouteMismatch -> RouteResult a
+failWith = RR . Left
+
+succeedWith :: a -> RouteResult a
+succeedWith = RR . Right
+
+isMismatch :: RouteResult a -> Bool
+isMismatch (RR (Left _)) = True
+isMismatch _             = False
+
diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs
index 2689a4e2..00087d93 100644
--- a/servant-server/test/Servant/ServerSpec.hs
+++ b/servant-server/test/Servant/ServerSpec.hs
@@ -42,7 +42,8 @@ import           Servant.API                ((:<|>) (..), (:>),
                                              Post, Put, QueryFlag, QueryParam,
                                              QueryParams, Raw, ReqBody)
 import           Servant.Server             (Server, serve, ServantErr(..), err404)
-import           Servant.Server.Internal    (RouteMismatch (..))
+import           Servant.Server.Internal.RoutingApplication
+                                            (RouteMismatch (..))
 
 
 -- * test data types
@@ -89,6 +90,7 @@ spec = do
   headerSpec
   rawSpec
   unionSpec
+  prioErrorsSpec
   errorsSpec
   responseHeadersSpec
 
@@ -572,6 +574,54 @@ responseHeadersSpec = describe "ResponseHeaders" $ do
         Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
           `shouldRespondWith` 415
 
+type PrioErrorsApi = ReqBody '[JSON] Person :> "foo" :> Get '[JSON] Integer
+
+prioErrorsApi :: Proxy PrioErrorsApi
+prioErrorsApi = Proxy
+
+-- | Test the relative priority of error responses from the server.
+--
+-- In particular, we check whether matching continues even if a 'ReqBody'
+-- or similar construct is encountered early in a path. We don't want to
+-- see a complaint about the request body unless the path actually matches.
+--
+prioErrorsSpec :: Spec
+prioErrorsSpec = describe "PrioErrors" $ do
+  let server = return . age
+  with (return $ serve prioErrorsApi server) $ do
+    let check (mdescr, method) path (cdescr, ctype, body) resp =
+          it fulldescr $
+            Test.Hspec.Wai.request method path [(hContentType, ctype)] body
+              `shouldRespondWith` resp
+          where
+            fulldescr = "returns " ++ show (matchStatus resp) ++ " on " ++ mdescr
+                     ++ " " ++ cs path ++ " (" ++ cdescr ++ ")"
+
+        get' = ("GET", methodGet)
+        put' = ("PUT", methodPut)
+
+        txt   = ("text"        , "text/plain;charset=utf8"      , "42"        )
+        ijson = ("invalid json", "application/json;charset=utf8", "invalid"   )
+        vjson = ("valid json"  , "application/json;charset=utf8", encode alice)
+
+    check get' "/"    txt   404
+    check get' "/bar" txt   404
+    check get' "/foo" txt   415
+    check put' "/"    txt   404
+    check put' "/bar" txt   404
+    check put' "/foo" txt   405
+    check get' "/"    ijson 404
+    check get' "/bar" ijson 404
+    check get' "/foo" ijson 400
+    check put' "/"    ijson 404
+    check put' "/bar" ijson 404
+    check put' "/foo" ijson 405
+    check get' "/"    vjson 404
+    check get' "/bar" vjson 404
+    check get' "/foo" vjson 200
+    check put' "/"    vjson 404
+    check put' "/bar" vjson 404
+    check put' "/foo" vjson 405
 
 -- | Test server error functionality.
 errorsSpec :: Spec