git.iko.soy/servant
on master help sign in
Switch server interpretation to a datatype for efficiency.
f9b1e7fAndres Loeh
servant-server/servant-server.cabal+1
compare with master
unifiedsplit
@@ -43,6 +43,7 @@ library
43 , aeson >= 0.7 && < 0.9
43 , aeson >= 0.7 && < 0.9
44 , attoparsec >= 0.12 && < 0.14
44 , attoparsec >= 0.12 && < 0.14
45 , bytestring >= 0.10 && < 0.11
45 , bytestring >= 0.10 && < 0.11
46+ , containers >= 0.5 && < 0.6
46 , either >= 4.3 && < 4.5
47 , either >= 4.3 && < 4.5
47 , http-types >= 0.8 && < 0.9
48 , http-types >= 0.8 && < 0.9
48 , network-uri >= 2.6 && < 2.7
49 , network-uri >= 2.6 && < 2.7
servant-server/src/Servant/Server.hs+1−1
@@ -108,7 +108,7 @@ import Servant.Server.Internal.ServantErr
108-- > main = Network.Wai.Handler.Warp.run 8080 app
108-- > main = Network.Wai.Handler.Warp.run 8080 app
109--
109--
110serve :: HasServer layout => Proxy layout -> Server layout -> Application
110serve :: HasServer layout => Proxy layout -> Server layout -> Application
111−serve p server = toApplication (route p server)
111+serve p server = toApplication (runRouter (route p (return (RR (Right server)))))
112
112
113
113
114-- Documentation
114-- Documentation
servant-server/src/Servant/Server/Internal.hs+346−278
@@ -2,6 +2,7 @@
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE ScopedTypeVariables #-}
@@ -14,7 +15,7 @@
14module Servant.Server.Internal where
15module Servant.Server.Internal where
15
16
16#if !MIN_VERSION_base(4,8,0)
17#if !MIN_VERSION_base(4,8,0)
17−import Control.Applicative ((<$>))
18+import Control.Applicative (Applicative, (<$>))
18import Data.Monoid (Monoid, mappend, mempty)
19import Data.Monoid (Monoid, mappend, mempty)
19#endif
20#endif
20import Control.Monad.Trans.Either (EitherT, runEitherT)
21import Control.Monad.Trans.Either (EitherT, runEitherT)
@@ -22,6 +23,7 @@ import qualified Data.ByteString as B
22import qualified Data.ByteString.Lazy as BL
23import qualified Data.ByteString.Lazy as BL
23import Data.IORef (newIORef, readIORef, writeIORef)
24import Data.IORef (newIORef, readIORef, writeIORef)
24import Data.List (unfoldr)
25import Data.List (unfoldr)
26+import qualified Data.Map as M
25import Data.Maybe (catMaybes, fromMaybe)
27import Data.Maybe (catMaybes, fromMaybe)
26import Data.String (fromString)
28import Data.String (fromString)
27import Data.String.Conversions (cs, (<>))
29import Data.String.Conversions (cs, (<>))
@@ -52,6 +54,68 @@ import Servant.Common.Text (FromText, fromText)
52
54
53import Servant.Server.Internal.ServantErr
55import Servant.Server.Internal.ServantErr
54
56
57+-- | Internal representation of a router.
58+data Router =
59+ WithRequest (Request -> Router)
60+ -- ^ current request is passed to the router
61+ | StaticRouter (M.Map Text Router)
62+ -- ^ first path component used for lookup and removed afterwards
63+ | DynamicRouter (Text -> Router)
64+ -- ^ first path component used for lookup and removed afterwards
65+ | LeafRouter RoutingApplication
66+ -- ^ to be used for routes that match an empty path
67+ | Choice Router Router
68+ -- ^ left-biased choice between two routers
69+
70+-- | Smart constructor for the choice between routers.
71+-- We currently optimize the following cases:
72+--
73+-- * Two static routers can be joined by joining their maps.
74+-- * Two dynamic routers can be joined by joining their codomains.
75+-- * Two 'WithRequest' routers can be joined by passing them
76+-- the same request and joining their codomains.
77+-- * A 'WithRequest' router can be joined with anything else by
78+-- passing the same request to both but ignoring it in the
79+-- component that does not need it.
80+--
81+choice :: Router -> Router -> Router
82+choice (StaticRouter table1) (StaticRouter table2) =
83+ StaticRouter (M.unionWith choice table1 table2)
84+choice (DynamicRouter fun1) (DynamicRouter fun2) =
85+ DynamicRouter (\ first -> choice (fun1 first) (fun2 first))
86+choice (WithRequest router1) (WithRequest router2) =
87+ WithRequest (\ request -> choice (router1 request) (router2 request))
88+choice (WithRequest router1) router2 =
89+ WithRequest (\ request -> choice (router1 request) router2)
90+choice router1 (WithRequest router2) =
91+ WithRequest (\ request -> choice router1 (router2 request))
92+choice router1 router2 = Choice router1 router2
93+
94+-- | Interpret a router as an application.
95+runRouter :: Router -> RoutingApplication
96+runRouter (WithRequest router) request respond =
97+ runRouter (router request) request respond
98+runRouter (StaticRouter table) request respond =
99+ case processedPathInfo request of
100+ first : rest
101+ | Just router <- M.lookup first table
102+ -> let request' = request { pathInfo = rest }
103+ in runRouter router request' respond
104+ _ -> respond $ failWith NotFound
105+runRouter (DynamicRouter fun) request respond =
106+ case processedPathInfo request of
107+ first : rest
108+ -> let request' = request { pathInfo = rest }
109+ in runRouter (fun first) request' respond
110+ _ -> respond $ failWith NotFound
111+runRouter (LeafRouter app) request respond = app request respond
112+runRouter (Choice r1 r2) request respond =
113+ runRouter r1 request $ \ mResponse1 ->
114+ if isMismatch mResponse1
115+ then runRouter r2 request $ \ mResponse2 ->
116+ respond (mResponse1 <> mResponse2)
117+ else respond mResponse1
118+
55data ReqBodyState = Uncalled
119data ReqBodyState = Uncalled
56 | Called !B.ByteString
120 | Called !B.ByteString
57 | Done !B.ByteString
121 | Done !B.ByteString
@@ -120,7 +184,33 @@ instance Monoid RouteMismatch where
120-- | A wrapper around @'Either' 'RouteMismatch' a@.
184-- | A wrapper around @'Either' 'RouteMismatch' a@.
121newtype RouteResult a =
185newtype RouteResult a =
122 RR { routeResult :: Either RouteMismatch a }
186 RR { routeResult :: Either RouteMismatch a }
123− deriving (Eq, Show)
187+ deriving (Eq, Show, Functor, Applicative)
188+
189+runAction :: IO (RouteResult (EitherT ServantErr IO a))
190+ -> (RouteResult Response -> IO r)
191+ -> (a -> RouteResult Response)
192+ -> IO r
193+runAction action respond k = do
194+ r <- action
195+ go r
196+ where
197+ go (RR (Right a)) = do
198+ e <- runEitherT a
199+ respond $ case e of
200+ Right x -> k x
201+ Left err -> succeedWith $ responseServantErr err
202+ go (RR (Left err)) = respond $ failWith err
203+
204+feedTo :: IO (RouteResult (a -> b)) -> a -> IO (RouteResult b)
205+feedTo f x = (($ x) <$>) <$> f
206+
207+extractL :: RouteResult (a :<|> b) -> RouteResult a
208+extractL (RR (Right (a :<|> _))) = RR (Right a)
209+extractL (RR (Left err)) = RR (Left err)
210+
211+extractR :: RouteResult (a :<|> b) -> RouteResult b
212+extractR (RR (Right (_ :<|> b))) = RR (Right b)
213+extractR (RR (Left err)) = RR (Left err)
124
214
125failWith :: RouteMismatch -> RouteResult a
215failWith :: RouteMismatch -> RouteResult a
126failWith = RR . Left
216failWith = RR . Left
@@ -179,7 +269,7 @@ processedPathInfo r =
179class HasServer layout where
269class HasServer layout where
180 type ServerT layout (m :: * -> *) :: *
270 type ServerT layout (m :: * -> *) :: *
181
271
182− route :: Proxy layout -> Server layout -> RoutingApplication
272+ route :: Proxy layout -> IO (RouteResult (Server layout)) -> Router
183
273
184type Server layout = ServerT layout (EitherT ServantErr IO)
274type Server layout = ServerT layout (EitherT ServantErr IO)
185
275
@@ -200,12 +290,8 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
200
290
201 type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
291 type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
202
292
203− route Proxy (a :<|> b) request respond =
293+ route Proxy server = choice (route pa (extractL <$> server))
204− route pa a request $ \mResponse ->
294+ (route pb (extractR <$> server))
205− if isMismatch mResponse
206− then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
207− else respond mResponse
208−
209 where pa = Proxy :: Proxy a
295 where pa = Proxy :: Proxy a
210 pb = Proxy :: Proxy b
296 pb = Proxy :: Proxy b
211
297
@@ -235,15 +321,12 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
235 type ServerT (Capture capture a :> sublayout) m =
321 type ServerT (Capture capture a :> sublayout) m =
236 a -> ServerT sublayout m
322 a -> ServerT sublayout m
237
323
238− route Proxy subserver request respond = case processedPathInfo request of
324+ route Proxy subserver =
239− (first : rest)
325+ DynamicRouter $ \ first ->
326+ route (Proxy :: Proxy sublayout)
240− -> case captured captureProxy first of
327+ (case captured captureProxy first of
241− Nothing -> respond $ failWith NotFound
328+ Nothing -> return $ failWith NotFound
242− Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{
329+ Just v -> feedTo subserver v)
243− pathInfo = rest
244− } respond
245− _ -> respond $ failWith NotFound
246−
247 where captureProxy = Proxy :: Proxy (Capture capture a)
330 where captureProxy = Proxy :: Proxy (Capture capture a)
248
331
249
332
@@ -267,20 +350,19 @@ instance
267
350
268 type ServerT (Delete ctypes a) m = m a
351 type ServerT (Delete ctypes a) m = m a
269
352
353+ route Proxy action = LeafRouter route'
354+ where
270− route Proxy action request respond
355+ route' request respond
271− | pathIsEmpty request && requestMethod request == methodDelete = do
356+ | pathIsEmpty request && requestMethod request == methodDelete = do
272− e <- runEitherT action
357+ runAction action respond $ \ output -> do
273− respond $ case e of
274− Right output -> do
275− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
358+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
276− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
359+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
277− Nothing -> failWith UnsupportedMediaType
360+ Nothing -> failWith UnsupportedMediaType
278− Just (contentT, body) -> succeedWith $
361+ Just (contentT, body) -> succeedWith $
279− responseLBS status200 [ ("Content-Type" , cs contentT)] body
362+ responseLBS status200 [ ("Content-Type" , cs contentT)] body
280− Left err -> succeedWith $ responseServantErr err
281− | pathIsEmpty request && requestMethod request /= methodDelete =
363+ | pathIsEmpty request && requestMethod request /= methodDelete =
282− respond $ failWith WrongMethod
364+ respond $ failWith WrongMethod
283− | otherwise = respond $ failWith NotFound
365+ | otherwise = respond $ failWith NotFound
284
366
285instance
367instance
286#if MIN_VERSION_base(4,8,0)
368#if MIN_VERSION_base(4,8,0)
@@ -290,15 +372,15 @@ instance
290
372
291 type ServerT (Delete ctypes ()) m = m ()
373 type ServerT (Delete ctypes ()) m = m ()
292
374
375+ route Proxy action = LeafRouter route'
376+ where
293− route Proxy action request respond
377+ route' request respond
294− | pathIsEmpty request && requestMethod request == methodDelete = do
378+ | pathIsEmpty request && requestMethod request == methodDelete = do
295− e <- runEitherT action
379+ runAction action respond $ \ () ->
296− respond . succeedWith $ case e of
297− Right () -> responseLBS noContent204 [] ""
380+ succeedWith $ responseLBS noContent204 [] ""
298− Left err -> responseServantErr err
299− | pathIsEmpty request && requestMethod request /= methodDelete =
381+ | pathIsEmpty request && requestMethod request /= methodDelete =
300− respond $ failWith WrongMethod
382+ respond $ failWith WrongMethod
301− | otherwise = respond $ failWith NotFound
383+ | otherwise = respond $ failWith NotFound
302
384
303-- Add response headers
385-- Add response headers
304instance
386instance
@@ -310,21 +392,20 @@ instance
310
392
311 type ServerT (Delete ctypes (Headers h v)) m = m (Headers h v)
393 type ServerT (Delete ctypes (Headers h v)) m = m (Headers h v)
312
394
395+ route Proxy action = LeafRouter route'
396+ where
313− route Proxy action request respond
397+ route' request respond
314− | pathIsEmpty request && requestMethod request == methodDelete = do
398+ | pathIsEmpty request && requestMethod request == methodDelete = do
315− e <- runEitherT action
399+ runAction action respond $ \ output -> do
316− respond $ case e of
317− Right output -> do
318− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
400+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
319− headers = getHeaders output
401+ headers = getHeaders output
320− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
402+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
321− Nothing -> failWith UnsupportedMediaType
403+ Nothing -> failWith UnsupportedMediaType
322− Just (contentT, body) -> succeedWith $
404+ Just (contentT, body) -> succeedWith $
323− responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
405+ responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
324− Left err -> succeedWith $ responseServantErr err
325− | pathIsEmpty request && requestMethod request /= methodDelete =
406+ | pathIsEmpty request && requestMethod request /= methodDelete =
326− respond $ failWith WrongMethod
407+ respond $ failWith WrongMethod
327− | otherwise = respond $ failWith NotFound
408+ | otherwise = respond $ failWith NotFound
328
409
329-- | When implementing the handler for a 'Get' endpoint,
410-- | When implementing the handler for a 'Get' endpoint,
330-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'
411-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'
@@ -347,20 +428,19 @@ instance
347
428
348 type ServerT (Get ctypes a) m = m a
429 type ServerT (Get ctypes a) m = m a
349
430
431+ route Proxy action = LeafRouter route'
432+ where
350− route Proxy action request respond
433+ route' request respond
351− | pathIsEmpty request && requestMethod request == methodGet = do
434+ | pathIsEmpty request && requestMethod request == methodGet = do
352− e <- runEitherT action
435+ runAction action respond $ \ output -> do
353− respond $ case e of
354− Right output -> do
355− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
436+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
356− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
437+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
357− Nothing -> failWith UnsupportedMediaType
438+ Nothing -> failWith UnsupportedMediaType
358− Just (contentT, body) -> succeedWith $
439+ Just (contentT, body) -> succeedWith $
359− responseLBS ok200 [ ("Content-Type" , cs contentT)] body
440+ responseLBS ok200 [ ("Content-Type" , cs contentT)] body
360− Left err -> succeedWith $ responseServantErr err
361− | pathIsEmpty request && requestMethod request /= methodGet =
441+ | pathIsEmpty request && requestMethod request /= methodGet =
362− respond $ failWith WrongMethod
442+ respond $ failWith WrongMethod
363− | otherwise = respond $ failWith NotFound
443+ | otherwise = respond $ failWith NotFound
364
444
365-- '()' ==> 204 No Content
445-- '()' ==> 204 No Content
366instance
446instance
@@ -371,15 +451,15 @@ instance
371
451
372 type ServerT (Get ctypes ()) m = m ()
452 type ServerT (Get ctypes ()) m = m ()
373
453
454+ route Proxy action = LeafRouter route'
455+ where
374− route Proxy action request respond
456+ route' request respond
375− | pathIsEmpty request && requestMethod request == methodGet = do
457+ | pathIsEmpty request && requestMethod request == methodGet = do
376− e <- runEitherT action
458+ runAction action respond $ \ () ->
377− respond . succeedWith $ case e of
378− Right () -> responseLBS noContent204 [] ""
459+ succeedWith $ responseLBS noContent204 [] ""
379− Left err -> responseServantErr err
380− | pathIsEmpty request && requestMethod request /= methodGet =
460+ | pathIsEmpty request && requestMethod request /= methodGet =
381− respond $ failWith WrongMethod
461+ respond $ failWith WrongMethod
382− | otherwise = respond $ failWith NotFound
462+ | otherwise = respond $ failWith NotFound
383
463
384-- Add response headers
464-- Add response headers
385instance
465instance
@@ -391,21 +471,20 @@ instance
391
471
392 type ServerT (Get ctypes (Headers h v)) m = m (Headers h v)
472 type ServerT (Get ctypes (Headers h v)) m = m (Headers h v)
393
473
474+ route Proxy action = LeafRouter route'
475+ where
394− route Proxy action request respond
476+ route' request respond
395− | pathIsEmpty request && requestMethod request == methodGet = do
477+ | pathIsEmpty request && requestMethod request == methodGet = do
396− e <- runEitherT action
478+ runAction action respond $ \ output -> do
397− respond $ case e of
398− Right output -> do
399− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
479+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
400− headers = getHeaders output
480+ headers = getHeaders output
401− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
481+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
402− Nothing -> failWith UnsupportedMediaType
482+ Nothing -> failWith UnsupportedMediaType
403− Just (contentT, body) -> succeedWith $
483+ Just (contentT, body) -> succeedWith $
404− responseLBS ok200 ( ("Content-Type" , cs contentT) : headers) body
484+ responseLBS ok200 ( ("Content-Type" , cs contentT) : headers) body
405− Left err -> succeedWith $ responseServantErr err
406− | pathIsEmpty request && requestMethod request /= methodGet =
485+ | pathIsEmpty request && requestMethod request /= methodGet =
407− respond $ failWith WrongMethod
486+ respond $ failWith WrongMethod
408− | otherwise = respond $ failWith NotFound
487+ | otherwise = respond $ failWith NotFound
409
488
410-- | If you use 'Header' in one of the endpoints for your API,
489-- | If you use 'Header' in one of the endpoints for your API,
411-- this automatically requires your server-side handler to be a function
490-- this automatically requires your server-side handler to be a function
@@ -433,11 +512,10 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
433 type ServerT (Header sym a :> sublayout) m =
512 type ServerT (Header sym a :> sublayout) m =
434 Maybe a -> ServerT sublayout m
513 Maybe a -> ServerT sublayout m
435
514
436− route Proxy subserver request respond = do
515+ route Proxy subserver = WithRequest $ \ request ->
437 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
516 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
438− route (Proxy :: Proxy sublayout) (subserver mheader) request respond
517+ in route (Proxy :: Proxy sublayout) (feedTo subserver mheader)
439−
440− where str = fromString $ symbolVal (Proxy :: Proxy sym)
518+ where str = fromString $ symbolVal (Proxy :: Proxy sym)
441
519
442-- | When implementing the handler for a 'Post' endpoint,
520-- | When implementing the handler for a 'Post' endpoint,
443-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
521-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
@@ -461,20 +539,19 @@ instance
461
539
462 type ServerT (Post ctypes a) m = m a
540 type ServerT (Post ctypes a) m = m a
463
541
542+ route Proxy action = LeafRouter route'
543+ where
464− route Proxy action request respond
544+ route' request respond
465− | pathIsEmpty request && requestMethod request == methodPost = do
545+ | pathIsEmpty request && requestMethod request == methodPost = do
466− e <- runEitherT action
546+ runAction action respond $ \ output -> do
467− respond $ case e of
468− Right output -> do
469− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
547+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
470− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
548+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
471− Nothing -> failWith UnsupportedMediaType
549+ Nothing -> failWith UnsupportedMediaType
472− Just (contentT, body) -> succeedWith $
550+ Just (contentT, body) -> succeedWith $
473− responseLBS status201 [ ("Content-Type" , cs contentT)] body
551+ responseLBS status201 [ ("Content-Type" , cs contentT)] body
474− Left err -> succeedWith $ responseServantErr err
475− | pathIsEmpty request && requestMethod request /= methodPost =
552+ | pathIsEmpty request && requestMethod request /= methodPost =
476− respond $ failWith WrongMethod
553+ respond $ failWith WrongMethod
477− | otherwise = respond $ failWith NotFound
554+ | otherwise = respond $ failWith NotFound
478
555
479instance
556instance
480#if MIN_VERSION_base(4,8,0)
557#if MIN_VERSION_base(4,8,0)
@@ -484,15 +561,15 @@ instance
484
561
485 type ServerT (Post ctypes ()) m = m ()
562 type ServerT (Post ctypes ()) m = m ()
486
563
564+ route Proxy action = LeafRouter route'
565+ where
487− route Proxy action request respond
566+ route' request respond
488− | pathIsEmpty request && requestMethod request == methodPost = do
567+ | pathIsEmpty request && requestMethod request == methodPost = do
489− e <- runEitherT action
568+ runAction action respond $ \ () ->
490− respond . succeedWith $ case e of
491− Right () -> responseLBS noContent204 [] ""
569+ succeedWith $ responseLBS noContent204 [] ""
492− Left err -> responseServantErr err
493− | pathIsEmpty request && requestMethod request /= methodPost =
570+ | pathIsEmpty request && requestMethod request /= methodPost =
494− respond $ failWith WrongMethod
571+ respond $ failWith WrongMethod
495− | otherwise = respond $ failWith NotFound
572+ | otherwise = respond $ failWith NotFound
496
573
497-- Add response headers
574-- Add response headers
498instance
575instance
@@ -504,21 +581,20 @@ instance
504
581
505 type ServerT (Post ctypes (Headers h v)) m = m (Headers h v)
582 type ServerT (Post ctypes (Headers h v)) m = m (Headers h v)
506
583
584+ route Proxy action = LeafRouter route'
585+ where
507− route Proxy action request respond
586+ route' request respond
508− | pathIsEmpty request && requestMethod request == methodPost = do
587+ | pathIsEmpty request && requestMethod request == methodPost = do
509− e <- runEitherT action
588+ runAction action respond $ \ output -> do
510− respond $ case e of
511− Right output -> do
512− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
589+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
513− headers = getHeaders output
590+ headers = getHeaders output
514− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
591+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
515− Nothing -> failWith UnsupportedMediaType
592+ Nothing -> failWith UnsupportedMediaType
516− Just (contentT, body) -> succeedWith $
593+ Just (contentT, body) -> succeedWith $
517− responseLBS status201 ( ("Content-Type" , cs contentT) : headers) body
594+ responseLBS status201 ( ("Content-Type" , cs contentT) : headers) body
518− Left err -> succeedWith $ responseServantErr err
519− | pathIsEmpty request && requestMethod request /= methodPost =
595+ | pathIsEmpty request && requestMethod request /= methodPost =
520− respond $ failWith WrongMethod
596+ respond $ failWith WrongMethod
521− | otherwise = respond $ failWith NotFound
597+ | otherwise = respond $ failWith NotFound
522
598
523-- | When implementing the handler for a 'Put' endpoint,
599-- | When implementing the handler for a 'Put' endpoint,
524-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
600-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
@@ -541,20 +617,19 @@ instance
541
617
542 type ServerT (Put ctypes a) m = m a
618 type ServerT (Put ctypes a) m = m a
543
619
620+ route Proxy action = LeafRouter route'
621+ where
544− route Proxy action request respond
622+ route' request respond
545− | pathIsEmpty request && requestMethod request == methodPut = do
623+ | pathIsEmpty request && requestMethod request == methodPut = do
546− e <- runEitherT action
624+ runAction action respond $ \ output -> do
547− respond $ case e of
548− Right output -> do
549− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
625+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
550− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
626+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
551− Nothing -> failWith UnsupportedMediaType
627+ Nothing -> failWith UnsupportedMediaType
552− Just (contentT, body) -> succeedWith $
628+ Just (contentT, body) -> succeedWith $
553− responseLBS status200 [ ("Content-Type" , cs contentT)] body
629+ responseLBS status200 [ ("Content-Type" , cs contentT)] body
554− Left err -> succeedWith $ responseServantErr err
555− | pathIsEmpty request && requestMethod request /= methodPut =
630+ | pathIsEmpty request && requestMethod request /= methodPut =
556− respond $ failWith WrongMethod
631+ respond $ failWith WrongMethod
557− | otherwise = respond $ failWith NotFound
632+ | otherwise = respond $ failWith NotFound
558
633
559instance
634instance
560#if MIN_VERSION_base(4,8,0)
635#if MIN_VERSION_base(4,8,0)
@@ -564,15 +639,15 @@ instance
564
639
565 type ServerT (Put ctypes ()) m = m ()
640 type ServerT (Put ctypes ()) m = m ()
566
641
642+ route Proxy action = LeafRouter route'
643+ where
567− route Proxy action request respond
644+ route' request respond
568− | pathIsEmpty request && requestMethod request == methodPut = do
645+ | pathIsEmpty request && requestMethod request == methodPut = do
569− e <- runEitherT action
646+ runAction action respond $ \ () ->
570− respond . succeedWith $ case e of
571− Right () -> responseLBS noContent204 [] ""
647+ succeedWith $ responseLBS noContent204 [] ""
572− Left err -> responseServantErr err
573− | pathIsEmpty request && requestMethod request /= methodPut =
648+ | pathIsEmpty request && requestMethod request /= methodPut =
574− respond $ failWith WrongMethod
649+ respond $ failWith WrongMethod
575− | otherwise = respond $ failWith NotFound
650+ | otherwise = respond $ failWith NotFound
576
651
577-- Add response headers
652-- Add response headers
578instance
653instance
@@ -584,21 +659,20 @@ instance
584
659
585 type ServerT (Put ctypes (Headers h v)) m = m (Headers h v)
660 type ServerT (Put ctypes (Headers h v)) m = m (Headers h v)
586
661
662+ route Proxy action = LeafRouter route'
663+ where
587− route Proxy action request respond
664+ route' request respond
588− | pathIsEmpty request && requestMethod request == methodPut = do
665+ | pathIsEmpty request && requestMethod request == methodPut = do
589− e <- runEitherT action
666+ runAction action respond $ \ output -> do
590− respond $ case e of
591− Right output -> do
592− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
667+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
593− headers = getHeaders output
668+ headers = getHeaders output
594− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
669+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
595− Nothing -> failWith UnsupportedMediaType
670+ Nothing -> failWith UnsupportedMediaType
596− Just (contentT, body) -> succeedWith $
671+ Just (contentT, body) -> succeedWith $
597− responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
672+ responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
598− Left err -> succeedWith $ responseServantErr err
599− | pathIsEmpty request && requestMethod request /= methodPut =
673+ | pathIsEmpty request && requestMethod request /= methodPut =
600− respond $ failWith WrongMethod
674+ respond $ failWith WrongMethod
601− | otherwise = respond $ failWith NotFound
675+ | otherwise = respond $ failWith NotFound
602
676
603-- | When implementing the handler for a 'Patch' endpoint,
677-- | When implementing the handler for a 'Patch' endpoint,
604-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
678-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
@@ -619,20 +693,19 @@ instance
619
693
620 type ServerT (Patch ctypes a) m = m a
694 type ServerT (Patch ctypes a) m = m a
621
695
696+ route Proxy action = LeafRouter route'
697+ where
622− route Proxy action request respond
698+ route' request respond
623− | pathIsEmpty request && requestMethod request == methodPatch = do
699+ | pathIsEmpty request && requestMethod request == methodPatch = do
624− e <- runEitherT action
700+ runAction action respond $ \ output -> do
625− respond $ case e of
626− Right output -> do
627− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
701+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
628− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
702+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
629− Nothing -> failWith UnsupportedMediaType
703+ Nothing -> failWith UnsupportedMediaType
630− Just (contentT, body) -> succeedWith $
704+ Just (contentT, body) -> succeedWith $
631− responseLBS status200 [ ("Content-Type" , cs contentT)] body
705+ responseLBS status200 [ ("Content-Type" , cs contentT)] body
632− Left err -> succeedWith $ responseServantErr err
633− | pathIsEmpty request && requestMethod request /= methodPatch =
706+ | pathIsEmpty request && requestMethod request /= methodPatch =
634− respond $ failWith WrongMethod
707+ respond $ failWith WrongMethod
635− | otherwise = respond $ failWith NotFound
708+ | otherwise = respond $ failWith NotFound
636
709
637instance
710instance
638#if MIN_VERSION_base(4,8,0)
711#if MIN_VERSION_base(4,8,0)
@@ -642,15 +715,15 @@ instance
642
715
643 type ServerT (Patch ctypes ()) m = m ()
716 type ServerT (Patch ctypes ()) m = m ()
644
717
718+ route Proxy action = LeafRouter route'
719+ where
645− route Proxy action request respond
720+ route' request respond
646− | pathIsEmpty request && requestMethod request == methodPatch = do
721+ | pathIsEmpty request && requestMethod request == methodPatch = do
647− e <- runEitherT action
722+ runAction action respond $ \ () ->
648− respond . succeedWith $ case e of
649− Right () -> responseLBS noContent204 [] ""
723+ succeedWith $ responseLBS noContent204 [] ""
650− Left err -> responseServantErr err
651− | pathIsEmpty request && requestMethod request /= methodPatch =
724+ | pathIsEmpty request && requestMethod request /= methodPatch =
652− respond $ failWith WrongMethod
725+ respond $ failWith WrongMethod
653− | otherwise = respond $ failWith NotFound
726+ | otherwise = respond $ failWith NotFound
654
727
655-- Add response headers
728-- Add response headers
656instance
729instance
@@ -662,21 +735,20 @@ instance
662
735
663 type ServerT (Patch ctypes (Headers h v)) m = m (Headers h v)
736 type ServerT (Patch ctypes (Headers h v)) m = m (Headers h v)
664
737
738+ route Proxy action = LeafRouter route'
739+ where
665− route Proxy action request respond
740+ route' request respond
666− | pathIsEmpty request && requestMethod request == methodPatch = do
741+ | pathIsEmpty request && requestMethod request == methodPatch = do
667− e <- runEitherT action
668− respond $ case e of
669− Right outpatch -> do
742+ runAction action respond $ \ outpatch -> do
670− let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
743+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
671− headers = getHeaders outpatch
744+ headers = getHeaders outpatch
672− case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
745+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
673− Nothing -> failWith UnsupportedMediaType
746+ Nothing -> failWith UnsupportedMediaType
674− Just (contentT, body) -> succeedWith $
747+ Just (contentT, body) -> succeedWith $
675− responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
748+ responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body
676− Left err -> succeedWith $ responseServantErr err
677− | pathIsEmpty request && requestMethod request /= methodPatch =
749+ | pathIsEmpty request && requestMethod request /= methodPatch =
678− respond $ failWith WrongMethod
750+ respond $ failWith WrongMethod
679− | otherwise = respond $ failWith NotFound
751+ | otherwise = respond $ failWith NotFound
680
752
681-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
753-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
682-- this automatically requires your server-side handler to be a function
754-- this automatically requires your server-side handler to be a function
@@ -705,7 +777,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
705 type ServerT (QueryParam sym a :> sublayout) m =
777 type ServerT (QueryParam sym a :> sublayout) m =
706 Maybe a -> ServerT sublayout m
778 Maybe a -> ServerT sublayout m
707
779
708− route Proxy subserver request respond = do
780+ route Proxy subserver = WithRequest $ \ request ->
709 let querytext = parseQueryText $ rawQueryString request
781 let querytext = parseQueryText $ rawQueryString request
710 param =
782 param =
711 case lookup paramname querytext of
783 case lookup paramname querytext of
@@ -713,9 +785,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
713 Just Nothing -> Nothing -- param present with no value -> Nothing
785 Just Nothing -> Nothing -- param present with no value -> Nothing
714 Just (Just v) -> fromText v -- if present, we try to convert to
786 Just (Just v) -> fromText v -- if present, we try to convert to
715 -- the right type
787 -- the right type
716−
717− route (Proxy :: Proxy sublayout) (subserver param) request respond
788+ in route (Proxy :: Proxy sublayout) (feedTo subserver param)
718−
719 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
789 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
720
790
721-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
791-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
@@ -743,16 +813,14 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
743 type ServerT (QueryParams sym a :> sublayout) m =
813 type ServerT (QueryParams sym a :> sublayout) m =
744 [a] -> ServerT sublayout m
814 [a] -> ServerT sublayout m
745
815
746− route Proxy subserver request respond = do
816+ route Proxy subserver = WithRequest $ \ request ->
747 let querytext = parseQueryText $ rawQueryString request
817 let querytext = parseQueryText $ rawQueryString request
748 -- if sym is "foo", we look for query string parameters
818 -- if sym is "foo", we look for query string parameters
749 -- named "foo" or "foo[]" and call fromText on the
819 -- named "foo" or "foo[]" and call fromText on the
750 -- corresponding values
820 -- corresponding values
751 parameters = filter looksLikeParam querytext
821 parameters = filter looksLikeParam querytext
752 values = catMaybes $ map (convert . snd) parameters
822 values = catMaybes $ map (convert . snd) parameters
753−
754− route (Proxy :: Proxy sublayout) (subserver values) request respond
823+ in route (Proxy :: Proxy sublayout) (feedTo subserver values)
755−
756 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
824 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
757 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
825 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
758 convert Nothing = Nothing
826 convert Nothing = Nothing
@@ -776,15 +844,13 @@ instance (KnownSymbol sym, HasServer sublayout)
776 type ServerT (QueryFlag sym :> sublayout) m =
844 type ServerT (QueryFlag sym :> sublayout) m =
777 Bool -> ServerT sublayout m
845 Bool -> ServerT sublayout m
778
846
779− route Proxy subserver request respond = do
847+ route Proxy subserver = WithRequest $ \ request ->
780 let querytext = parseQueryText $ rawQueryString request
848 let querytext = parseQueryText $ rawQueryString request
781 param = case lookup paramname querytext of
849 param = case lookup paramname querytext of
782 Just Nothing -> True -- param is there, with no value
850 Just Nothing -> True -- param is there, with no value
783 Just (Just v) -> examine v -- param with a value
851 Just (Just v) -> examine v -- param with a value
784 Nothing -> False -- param not in the query string
852 Nothing -> False -- param not in the query string
785−
786− route (Proxy :: Proxy sublayout) (subserver param) request respond
853+ in route (Proxy :: Proxy sublayout) (feedTo subserver param)
787−
788 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
854 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
789 examine v | v == "true" || v == "1" || v == "" = True
855 examine v | v == "true" || v == "1" || v == "" = True
790 | otherwise = False
856 | otherwise = False
@@ -819,16 +885,17 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
819 type ServerT (MatrixParam sym a :> sublayout) m =
885 type ServerT (MatrixParam sym a :> sublayout) m =
820 Maybe a -> ServerT sublayout m
886 Maybe a -> ServerT sublayout m
821
887
888+ route Proxy subserver = WithRequest $ \ request ->
822− route Proxy subserver request respond = case parsePathInfo request of
889+ case parsePathInfo request of
823− (first : _)
890+ (first : _)
824− -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
891+ -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
825− param = case lookup paramname querytext of
892+ param = case lookup paramname querytext of
826− Nothing -> Nothing -- param absent from the query string
893+ Nothing -> Nothing -- param absent from the query string
827− Just Nothing -> Nothing -- param present with no value -> Nothing
894+ Just Nothing -> Nothing -- param present with no value -> Nothing
828− Just (Just v) -> fromText v -- if present, we try to convert to
895+ Just (Just v) -> fromText v -- if present, we try to convert to
829− -- the right type
896+ -- the right type
830− route (Proxy :: Proxy sublayout) (subserver param) request respond
897+ route (Proxy :: Proxy sublayout) (feedTo subserver param)
831− _ -> route (Proxy :: Proxy sublayout) (subserver Nothing) request respond
898+ _ -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing)
832
899
833 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
900 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
834
901
@@ -857,16 +924,17 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
857 type ServerT (MatrixParams sym a :> sublayout) m =
924 type ServerT (MatrixParams sym a :> sublayout) m =
858 [a] -> ServerT sublayout m
925 [a] -> ServerT sublayout m
859
926
927+ route Proxy subserver = WithRequest $ \ request ->
860− route Proxy subserver request respond = case parsePathInfo request of
928+ case parsePathInfo request of
861− (first : _)
929+ (first : _)
862− -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
930+ -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
863− -- if sym is "foo", we look for matrix parameters
931+ -- if sym is "foo", we look for matrix parameters
864− -- named "foo" or "foo[]" and call fromText on the
932+ -- named "foo" or "foo[]" and call fromText on the
865− -- corresponding values
933+ -- corresponding values
866− parameters = filter looksLikeParam matrixtext
934+ parameters = filter looksLikeParam matrixtext
867− values = catMaybes $ map (convert . snd) parameters
935+ values = catMaybes $ map (convert . snd) parameters
868− route (Proxy :: Proxy sublayout) (subserver values) request respond
936+ route (Proxy :: Proxy sublayout) (feedTo subserver values)
869− _ -> route (Proxy :: Proxy sublayout) (subserver []) request respond
937+ _ -> route (Proxy :: Proxy sublayout) (feedTo subserver [])
870
938
871 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
939 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
872 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
940 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
@@ -891,17 +959,18 @@ instance (KnownSymbol sym, HasServer sublayout)
891 type ServerT (MatrixFlag sym :> sublayout) m =
959 type ServerT (MatrixFlag sym :> sublayout) m =
892 Bool -> ServerT sublayout m
960 Bool -> ServerT sublayout m
893
961
962+ route Proxy subserver = WithRequest $ \ request ->
894− route Proxy subserver request respond = case parsePathInfo request of
963+ case parsePathInfo request of
895− (first : _)
964+ (first : _)
896− -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
965+ -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
897− param = case lookup paramname matrixtext of
966+ param = case lookup paramname matrixtext of
898− Just Nothing -> True -- param is there, with no value
967+ Just Nothing -> True -- param is there, with no value
899− Just (Just v) -> examine v -- param with a value
968+ Just (Just v) -> examine v -- param with a value
900− Nothing -> False -- param not in the query string
969+ Nothing -> False -- param not in the query string
901−
970+
902− route (Proxy :: Proxy sublayout) (subserver param) request respond
971+ route (Proxy :: Proxy sublayout) (feedTo subserver param)
903−
972+
904− _ -> route (Proxy :: Proxy sublayout) (subserver False) request respond
973+ _ -> route (Proxy :: Proxy sublayout) (feedTo subserver False)
905
974
906 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
975 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
907 examine v | v == "true" || v == "1" || v == "" = True
976 examine v | v == "true" || v == "1" || v == "" = True
@@ -919,8 +988,11 @@ instance HasServer Raw where
919
988
920 type ServerT Raw m = Application
989 type ServerT Raw m = Application
921
990
922− route Proxy rawApplication request respond =
991+ route Proxy rawApplication = LeafRouter $ \ request respond -> do
992+ r <- rawApplication
993+ case r of
994+ RR (Left err) -> respond $ failWith err
923− rawApplication request (respond . succeedWith)
995+ RR (Right app) -> app request (respond . succeedWith)
924
996
925-- | If you use 'ReqBody' in one of the endpoints for your API,
997-- | If you use 'ReqBody' in one of the endpoints for your API,
926-- this automatically requires your server-side handler to be a function
998-- this automatically requires your server-side handler to be a function
@@ -948,19 +1020,20 @@ instance ( AllCTUnrender list a, HasServer sublayout
948 type ServerT (ReqBody list a :> sublayout) m =
1020 type ServerT (ReqBody list a :> sublayout) m =
949 a -> ServerT sublayout m
1021 a -> ServerT sublayout m
950
1022
951− route Proxy subserver request respond = do
1023+ route Proxy subserver = WithRequest $ \ request ->
1024+ route (Proxy :: Proxy sublayout) $ do
952− -- See HTTP RFC 2616, section 7.2.1
1025+ -- See HTTP RFC 2616, section 7.2.1
953− -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
1026+ -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
954− -- See also "W3C Internet Media Type registration, consistency of use"
1027+ -- See also "W3C Internet Media Type registration, consistency of use"
955− -- http://www.w3.org/2001/tag/2002/0129-mime
1028+ -- http://www.w3.org/2001/tag/2002/0129-mime
956− let contentTypeH = fromMaybe "application/octet-stream"
1029+ let contentTypeH = fromMaybe "application/octet-stream"
957− $ lookup hContentType $ requestHeaders request
1030+ $ lookup hContentType $ requestHeaders request
958− mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
1031+ mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
959− <$> lazyRequestBody request
1032+ <$> lazyRequestBody request
960− case mrqbody of
1033+ case mrqbody of
961− Nothing -> respond . failWith $ UnsupportedMediaType
1034+ Nothing -> return $ failWith $ UnsupportedMediaType
962− Just (Left e) -> respond . failWith $ InvalidBody e
1035+ Just (Left e) -> return $ failWith $ InvalidBody e
963− Just (Right v) -> route (Proxy :: Proxy sublayout) (subserver v) request respond
1036+ Just (Right v) -> feedTo subserver v
964
1037
965-- | Make sure the incoming request starts with @"/path"@, strip it and
1038-- | Make sure the incoming request starts with @"/path"@, strip it and
966-- pass the rest of the request path to @sublayout@.
1039-- pass the rest of the request path to @sublayout@.
@@ -968,14 +1041,9 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
968
1041
969 type ServerT (path :> sublayout) m = ServerT sublayout m
1042 type ServerT (path :> sublayout) m = ServerT sublayout m
970
1043
971− route Proxy subserver request respond = case processedPathInfo request of
1044+ route Proxy subserver = StaticRouter $
972− (first : rest)
973− | first == cs (symbolVal proxyPath)
1045+ M.singleton (cs (symbolVal proxyPath))
974− -> route (Proxy :: Proxy sublayout) subserver request{
1046+ (route (Proxy :: Proxy sublayout) subserver)
975− pathInfo = rest
976− } respond
977− _ -> respond $ failWith NotFound
978−
979 where proxyPath = Proxy :: Proxy path
1047 where proxyPath = Proxy :: Proxy path
980
1048
981ct_wildcard :: B.ByteString
1049ct_wildcard :: B.ByteString