@@ -160,9 +160,12 @@ processedPathInfo r =
160 where pinfo = parsePathInfo r
160 where pinfo = parsePathInfo r
162class HasServer layout where
162class HasServer layout where
163− type Server' layout :: *
163+ type ServerT layout (m :: * -> *) :: *
164 route :: Proxy layout -> Server' layout -> RoutingApplication
164 route :: Proxy layout -> Server' layout -> RoutingApplication
166+type Server' layout = ServerT layout (EitherT (Int, String) IO)
166-- * Instances
169-- * Instances
168-- | A server for @a ':<|>' b@ first tries to match the request against the route
171-- | A server for @a ':<|>' b@ first tries to match the request against the route
@@ -177,7 +180,9 @@ class HasServer layout where
177-- > where listAllBooks = ...
180-- > where listAllBooks = ...
178-- > postBook book = ...
181-- > postBook book = ...
179instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
182instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
180− type Server' (a :<|> b) = Server' a :<|> Server' b
183+
184+ type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
181 route Proxy (a :<|> b) request respond =
186 route Proxy (a :<|> b) request respond =
182 route pa a request $ \ mResponse ->
187 route pa a request $ \ mResponse ->
183 if isMismatch mResponse
188 if isMismatch mResponse
@@ -210,8 +215,8 @@ captured _ = fromText
210instance (KnownSymbol capture, FromText a, HasServer sublayout)
215instance (KnownSymbol capture, FromText a, HasServer sublayout)
211 => HasServer (Capture capture a :> sublayout) where
216 => HasServer (Capture capture a :> sublayout) where
213− type Server' (Capture capture a :> sublayout) =
218+ type ServerT (Capture capture a :> sublayout) m =
214− a -> Server' sublayout
219+ a -> ServerT sublayout m
216 route Proxy subserver request respond = case processedPathInfo request of
221 route Proxy subserver request respond = case processedPathInfo request of
217 (first : rest)
222 (first : rest)
@@ -237,7 +242,8 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
237-- painlessly error out if the conditions for a successful deletion
242-- painlessly error out if the conditions for a successful deletion
238-- are not met.
243-- are not met.
239instance HasServer Delete where
244instance HasServer Delete where
240− type Server' Delete = EitherT (Int, String) IO ()
245+
246+ type ServerT Delete m = m ()
242 route Proxy action request respond
248 route Proxy action request respond
243 | pathIsEmpty request && requestMethod request == methodDelete = do
249 | pathIsEmpty request && requestMethod request == methodDelete = do
@@ -266,7 +272,9 @@ instance HasServer Delete where
267instance ( AllCTRender ctypes a
273instance ( AllCTRender ctypes a
268 ) => HasServer (Get ctypes a) where
274 ) => HasServer (Get ctypes a) where
269− type Server' (Get ctypes a) = EitherT (Int, String) IO a
276+ type ServerT (Get ctypes a) m = m a
270 route Proxy action request respond
278 route Proxy action request respond
271 | pathIsEmpty request && requestMethod request == methodGet = do
279 | pathIsEmpty request && requestMethod request == methodGet = do
272 e <- runEitherT action
280 e <- runEitherT action
@@ -306,8 +314,8 @@ instance ( AllCTRender ctypes a
306instance (KnownSymbol sym, FromText a, HasServer sublayout)
314instance (KnownSymbol sym, FromText a, HasServer sublayout)
307 => HasServer (Header sym a :> sublayout) where
315 => HasServer (Header sym a :> sublayout) where
309− type Server' (Header sym a :> sublayout) =
317+ type ServerT (Header sym a :> sublayout) m =
310− Maybe a -> Server' sublayout
318+ Maybe a -> ServerT sublayout m
312 route Proxy subserver request respond = do
320 route Proxy subserver request respond = do
313 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
321 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
@@ -330,7 +338,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
331instance ( AllCTRender ctypes a
339instance ( AllCTRender ctypes a
332 ) => HasServer (Post ctypes a) where
340 ) => HasServer (Post ctypes a) where
333− type Server' (Post ctypes a) = EitherT (Int, String) IO a
342+ type ServerT (Post ctypes a) m = m a
335 route Proxy action request respond
344 route Proxy action request respond
336 | pathIsEmpty request && requestMethod request == methodPost = do
345 | pathIsEmpty request && requestMethod request == methodPost = do
@@ -363,7 +372,8 @@ instance ( AllCTRender ctypes a
364instance ( AllCTRender ctypes a
373instance ( AllCTRender ctypes a
365 ) => HasServer (Put ctypes a) where
374 ) => HasServer (Put ctypes a) where
366− type Server' (Put ctypes a) = EitherT (Int, String) IO a
376+ type ServerT (Put ctypes a) m = m a
368 route Proxy action request respond
378 route Proxy action request respond
369 | pathIsEmpty request && requestMethod request == methodPut = do
379 | pathIsEmpty request && requestMethod request == methodPut = do
@@ -396,7 +406,8 @@ instance ( AllCTRender ctypes a
396instance ( AllCTRender ctypes a
406instance ( AllCTRender ctypes a
397 , Typeable a
407 , Typeable a
398 , ToJSON a) => HasServer (Patch ctypes a) where
408 , ToJSON a) => HasServer (Patch ctypes a) where
399− type Server' (Patch ctypes a) = EitherT (Int, String) IO a
410+ type ServerT (Patch ctypes a) m = m a
401 route Proxy action request respond
412 route Proxy action request respond
402 | pathIsEmpty request && requestMethod request == methodPost = do
413 | pathIsEmpty request && requestMethod request == methodPost = do
@@ -440,8 +451,8 @@ instance ( AllCTRender ctypes a
440instance (KnownSymbol sym, FromText a, HasServer sublayout)
451instance (KnownSymbol sym, FromText a, HasServer sublayout)
441 => HasServer (QueryParam sym a :> sublayout) where
452 => HasServer (QueryParam sym a :> sublayout) where
443− type Server' (QueryParam sym a :> sublayout) =
454+ type ServerT (QueryParam sym a :> sublayout) m =
444− Maybe a -> Server' sublayout
455+ Maybe a -> ServerT sublayout m
446 route Proxy subserver request respond = do
457 route Proxy subserver request respond = do
447 let querytext = parseQueryText $ rawQueryString request
458 let querytext = parseQueryText $ rawQueryString request
@@ -478,8 +489,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
478instance (KnownSymbol sym, FromText a, HasServer sublayout)
489instance (KnownSymbol sym, FromText a, HasServer sublayout)
479 => HasServer (QueryParams sym a :> sublayout) where
490 => HasServer (QueryParams sym a :> sublayout) where
481− type Server' (QueryParams sym a :> sublayout) =
492+ type ServerT (QueryParams sym a :> sublayout) m =
482− [a] -> Server' sublayout
493+ [a] -> ServerT sublayout m
484 route Proxy subserver request respond = do
495 route Proxy subserver request respond = do
485 let querytext = parseQueryText $ rawQueryString request
496 let querytext = parseQueryText $ rawQueryString request
@@ -511,8 +522,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
511instance (KnownSymbol sym, HasServer sublayout)
522instance (KnownSymbol sym, HasServer sublayout)
512 => HasServer (QueryFlag sym :> sublayout) where
523 => HasServer (QueryFlag sym :> sublayout) where
514− type Server' (QueryFlag sym :> sublayout) =
525+ type ServerT (QueryFlag sym :> sublayout) m =
515− Bool -> Server' sublayout
526+ Bool -> ServerT sublayout m
517 route Proxy subserver request respond = do
528 route Proxy subserver request respond = do
518 let querytext = parseQueryText $ rawQueryString request
529 let querytext = parseQueryText $ rawQueryString request
@@ -554,8 +565,8 @@ parseMatrixText = parseQueryText
554instance (KnownSymbol sym, FromText a, HasServer sublayout)
565instance (KnownSymbol sym, FromText a, HasServer sublayout)
555 => HasServer (MatrixParam sym a :> sublayout) where
566 => HasServer (MatrixParam sym a :> sublayout) where
557− type Server' (MatrixParam sym a :> sublayout) =
568+ type ServerT (MatrixParam sym a :> sublayout) m =
558− Maybe a -> Server' sublayout
569+ Maybe a -> ServerT sublayout m
560 route Proxy subserver request respond = case parsePathInfo request of
571 route Proxy subserver request respond = case parsePathInfo request of
561 (first : _)
572 (first : _)
@@ -592,8 +603,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
592instance (KnownSymbol sym, FromText a, HasServer sublayout)
603instance (KnownSymbol sym, FromText a, HasServer sublayout)
593 => HasServer (MatrixParams sym a :> sublayout) where
604 => HasServer (MatrixParams sym a :> sublayout) where
595− type Server' (MatrixParams sym a :> sublayout) =
606+ type ServerT (MatrixParams sym a :> sublayout) m =
596− [a] -> Server' sublayout
607+ [a] -> ServerT sublayout m
598 route Proxy subserver request respond = case parsePathInfo request of
609 route Proxy subserver request respond = case parsePathInfo request of
599 (first : _)
610 (first : _)
@@ -626,8 +637,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
626instance (KnownSymbol sym, HasServer sublayout)
637instance (KnownSymbol sym, HasServer sublayout)
627 => HasServer (MatrixFlag sym :> sublayout) where
638 => HasServer (MatrixFlag sym :> sublayout) where
629− type Server' (MatrixFlag sym :> sublayout) =
640+ type ServerT (MatrixFlag sym :> sublayout) m =
630− Bool -> Server' sublayout
641+ Bool -> ServerT sublayout m
632 route Proxy subserver request respond = case parsePathInfo request of
643 route Proxy subserver request respond = case parsePathInfo request of
633 (first : _)
644 (first : _)
@@ -654,7 +665,9 @@ instance (KnownSymbol sym, HasServer sublayout)
654-- > server :: Server MyApi
665-- > server :: Server MyApi
655-- > server = serveDirectory "/var/www/images"
666-- > server = serveDirectory "/var/www/images"
656instance HasServer Raw where
667instance HasServer Raw where
657− type Server' Raw = Application
669+ type ServerT Raw m = Application
658 route Proxy rawApplication request respond =
671 route Proxy rawApplication request respond =
659 rawApplication request (respond . succeedWith)
672 rawApplication request (respond . succeedWith)
@@ -681,8 +694,8 @@ instance HasServer Raw where
681instance ( AllCTUnrender list a, HasServer sublayout
694instance ( AllCTUnrender list a, HasServer sublayout
682 ) => HasServer (ReqBody list a :> sublayout) where
695 ) => HasServer (ReqBody list a :> sublayout) where
684− type Server' (ReqBody list a :> sublayout) =
697+ type ServerT (ReqBody list a :> sublayout) m =
685− a -> Server' sublayout
698+ a -> ServerT sublayout m
687 route Proxy subserver request respond = do
700 route Proxy subserver request respond = do
688 -- See HTTP RFC 2616, section 7.2.1
701 -- See HTTP RFC 2616, section 7.2.1
@@ -701,7 +714,9 @@ instance ( AllCTUnrender list a, HasServer sublayout
701-- | Make sure the incoming request starts with @"/path"@, strip it and
714-- | Make sure the incoming request starts with @"/path"@, strip it and
702-- pass the rest of the request path to @sublayout@.
715-- pass the rest of the request path to @sublayout@.
703instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
716instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
704− type Server' (path :> sublayout) = Server' sublayout
718+ type ServerT (path :> sublayout) m = ServerT sublayout m
705 route Proxy subserver request respond = case processedPathInfo request of
720 route Proxy subserver request respond = case processedPathInfo request of
706 (first : rest)
721 (first : rest)
707 | first == cs (symbolVal proxyPath)
722 | first == cs (symbolVal proxyPath)