diff --git a/servant-server/example/greet.hs b/servant-server/example/greet.hs
index e354351f..5d95ddca 100644
--- a/servant-server/example/greet.hs
+++ b/servant-server/example/greet.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds         #-}
 {-# LANGUAGE TypeFamilies      #-}
@@ -16,6 +17,8 @@ import           Network.Wai
 import           Network.Wai.Handler.Warp
 
 import           Servant
+import           Servant.Server.Generic ()
+import           Servant.API.Generic
 
 -- * Example
 
@@ -38,6 +41,14 @@ type TestApi =
        -- DELETE /greet/:greetid
   :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent
 
+  :<|> NamedRoutes OtherRoutes
+
+data OtherRoutes mode = OtherRoutes
+  { version :: mode :- Get '[JSON] Int
+  , bye :: mode :- "bye" :> Capture "name" Text :> Get '[JSON] Text
+  }
+  deriving Generic
+
 testApi :: Proxy TestApi
 testApi = Proxy
 
@@ -48,9 +59,13 @@ testApi = Proxy
 --
 -- Each handler runs in the 'Handler' monad.
 server :: Server TestApi
-server = helloH :<|> postGreetH :<|> deleteGreetH
+server = helloH :<|> postGreetH :<|> deleteGreetH :<|> otherRoutes
+  where otherRoutes = OtherRoutes {..}
 
-  where helloH name Nothing = helloH name (Just False)
+        bye name = pure $ "Bye, " <> name <> " !"
+        version = pure 42
+
+        helloH name Nothing = helloH name (Just False)
         helloH name (Just False) = return . Greet $ "Hello, " <> name
         helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
 
diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal
index 0b3736e8..bc3e55fe 100644
--- a/servant-server/servant-server.cabal
+++ b/servant-server/servant-server.cabal
@@ -62,6 +62,7 @@ library
   build-depends:
       base                >= 4.9      && < 4.16
     , bytestring          >= 0.10.8.1 && < 0.12
+    , constraints
     , containers          >= 0.5.7.1  && < 0.7
     , mtl                 >= 2.2.2    && < 2.3
     , text                >= 1.2.3.0  && < 1.3
diff --git a/servant-server/src/Servant/Server/Generic.hs b/servant-server/src/Servant/Server/Generic.hs
index c3db01c3..c4a6f934 100644
--- a/servant-server/src/Servant/Server/Generic.hs
+++ b/servant-server/src/Servant/Server/Generic.hs
@@ -1,12 +1,20 @@
-{-# LANGUAGE ConstraintKinds      #-}
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE KindSignatures       #-}
-{-# LANGUAGE RankNTypes           #-}
-{-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans   #-}
+{-# LANGUAGE AllowAmbiguousTypes    #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE DefaultSignatures      #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE InstanceSigs           #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE QuantifiedConstraints  #-}
+{-# LANGUAGE RankNTypes             #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
 -- | @since 0.14.1
 module Servant.Server.Generic (
     AsServerT,
@@ -16,13 +24,20 @@ module Servant.Server.Generic (
     genericServeTWithContext,
     genericServer,
     genericServerT,
+    -- * Internal machinery
+    GServerConstraints,
+    GServer,
+    -- * Re-exports
+    NamedRoutes
   ) where
 
+import           Data.Constraint
 import           Data.Proxy
                  (Proxy (..))
 
 import           Servant.API.Generic
 import           Servant.Server
+import           Servant.Server.Internal
 
 -- | A type that specifies that an API record contains a server implementation.
 data AsServerT (m :: * -> *)
@@ -97,3 +112,64 @@ genericServerT
     => routes (AsServerT m)
     -> ToServant routes (AsServerT m)
 genericServerT = toServant
+
+-- | Set of constraints required to convert to / from vanilla server types.
+type GServerConstraints api m =
+  ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
+  , GServantProduct (Rep (api (AsServerT m)))
+  )
+
+-- | This class is a necessary evil: in the implementation of 'HasServer' for
+--  @'NamedRoutes' api@, we essentially need the quantified constraint @forall
+--  m. 'GServerConstraints' m@ to hold.
+--
+-- We cannot require do that directly as the definition of 'GServerConstraints'
+-- contains type family applications ('Rep' and 'ServerT'). The trick is to hide
+-- those type family applications behind a typeclass providing evidence for
+-- @'GServerConstraints' api m@ in the form of a dictionary, and require that
+-- @forall m. 'GServer' api m@ instead.
+--
+-- Users shouldn't have to worry about this class, as the only possible instance
+-- is provided in this module for all record APIs.
+
+class GServer (api :: * -> *) (m :: * -> *) where
+  proof :: Dict (GServerConstraints api m)
+
+instance
+  ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
+  , GServantProduct (Rep (api (AsServerT m)))
+  ) => GServer api m where
+  proof = Dict
+
+instance
+  ( HasServer (ToServantApi api) context
+  , forall m. Generic (api (AsServerT m))
+  , forall m. GServer api m
+  ) => HasServer (NamedRoutes api) context where
+
+  type ServerT (NamedRoutes api) m = api (AsServerT m)
+
+  route
+    :: Proxy (NamedRoutes api)
+    -> Context context
+    -> Delayed env (api (AsServerT Handler))
+    -> Router env
+  route _ ctx delayed =
+    case proof @api @Handler of
+      Dict -> route (Proxy @(ToServantApi api)) ctx (toServant <$> delayed)
+
+  hoistServerWithContext
+    :: forall m n. Proxy (NamedRoutes api)
+    -> Proxy context
+    -> (forall x. m x -> n x)
+    -> api (AsServerT m)
+    -> api (AsServerT n)
+  hoistServerWithContext _ pctx nat server =
+    case (proof @api @m, proof @api @n) of
+      (Dict, Dict) ->
+        fromServant servantSrvN
+        where
+          servantSrvM :: ServerT (ToServantApi api) m =
+            toServant server
+          servantSrvN :: ServerT (ToServantApi api) n =
+            hoistServerWithContext (Proxy @(ToServantApi api)) pctx nat servantSrvM