@@ -1,9 +1,10 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE RankNTypes #-}
5−{-# LANGUAGE TypeFamilies #-}
6−{-# LANGUAGE TypeOperators #-}
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE RankNTypes #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE TypeOperators #-}
78
89-- | This module lets you implement 'Server's for defined APIs. You'll
910-- most likely just need 'serve'.
@@ -11,6 +12,8 @@ module Servant.Server
1112 ( -- * Run a wai application from an API
1213 serve
1314 , serveWithContext
15+ , serveWithContextT
16+ , ServerContext
1417
1518 , -- * Construct a wai Application from an API
1619 toApplication
@@ -128,6 +131,15 @@ import Servant.Server.UVerb
128131
129132-- * Implementing Servers
130133
134+-- | Constraints that need to be satisfied on a context for it to be passed to 'serveWithContext'.
135+--
136+-- Typically, this will add default context entries to the context. You shouldn't typically
137+-- need to worry about these constraints, but if you write a helper function that wraps
138+-- 'serveWithContext', you might need to include this constraint.
139+type ServerContext context =
140+ ( HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters
141+ )
142+
131143-- | 'serve' allows you to implement an API and produce a wai 'Application'.
132144--
133145-- Example:
@@ -157,11 +169,21 @@ serve p = serveWithContext p EmptyContext
157169-- 'defaultErrorFormatters' will always be appended to the end of the passed context,
158170-- but if you pass your own formatter, it will override the default one.
159171serveWithContext :: ( HasServer api context
160− , HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters )
172+ , ServerContext context
173+ )
161174 => Proxy api -> Context context -> Server api -> Application
162−serveWithContext p context server =
163− toApplication (runRouter format404 (route p context (emptyDelayed (Route server))))
175+serveWithContext p context = serveWithContextT p context id
176+
177+-- | A general 'serve' function that allows you to pass a custom context and hoisting function to
178+-- apply on all routes.
179+serveWithContextT ::
180+ forall api context m.
181+ (HasServer api context, ServerContext context) =>
182+ Proxy api -> Context context -> (forall x. m x -> Handler x) -> ServerT api m -> Application
183+serveWithContextT p context toHandler server =
184+ toApplication (runRouter format404 (route p context (emptyDelayed router)))
164185 where
186+ router = Route $ hoistServerWithContext p (Proxy :: Proxy context) toHandler server
165187 format404 = notFoundErrorFormatter . getContextEntry . mkContextWithErrorFormatter $ context
166188
167189-- | Hoist server implementation.