@@ -160,9 +160,10 @@ 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)
168-- * Instances
169-- * Instances
@@ -179,7 +180,7 @@ class HasServer layout where
179-- > where listAllBooks = ...
180-- > where listAllBooks = ...
180-- > postBook book = ...
181-- > postBook book = ...
181instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
182instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
182− type Server (a :<|> b) = Server a :<|> Server b
183+ type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
183 route Proxy (a :<|> b) request respond =
184 route Proxy (a :<|> b) request respond =
184 route pa a request $ \ mResponse ->
185 route pa a request $ \ mResponse ->
185 if isMismatch mResponse
186 if isMismatch mResponse
@@ -212,8 +213,8 @@ captured _ = fromText
212instance (KnownSymbol capture, FromText a, HasServer sublayout)
213instance (KnownSymbol capture, FromText a, HasServer sublayout)
213 => HasServer (Capture capture a :> sublayout) where
214 => HasServer (Capture capture a :> sublayout) where
215− type Server (Capture capture a :> sublayout) =
216+ type ServerT (Capture capture a :> sublayout) m =
216− a -> Server sublayout
217+ a -> ServerT sublayout m
218 route Proxy subserver request respond = case processedPathInfo request of
219 route Proxy subserver request respond = case processedPathInfo request of
219 (first : rest)
220 (first : rest)
@@ -239,7 +240,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
239-- painlessly error out if the conditions for a successful deletion
240-- painlessly error out if the conditions for a successful deletion
240-- are not met.
241-- are not met.
241instance HasServer Delete where
242instance HasServer Delete where
242− type Server Delete = EitherT (Int, String) IO ()
243+ type ServerT Delete m = m ()
244 route Proxy action request respond
245 route Proxy action request respond
245 | pathIsEmpty request && requestMethod request == methodDelete = do
246 | pathIsEmpty request && requestMethod request == methodDelete = do
@@ -268,7 +269,7 @@ instance HasServer Delete where
269instance ( AllCTRender ctypes a
270instance ( AllCTRender ctypes a
270 ) => HasServer (Get ctypes a) where
271 ) => HasServer (Get ctypes a) where
271− type Server (Get ctypes a) = EitherT (Int, String) IO a
272+ type ServerT (Get ctypes a) m = m a
272 route Proxy action request respond
273 route Proxy action request respond
273 | pathIsEmpty request && requestMethod request == methodGet = do
274 | pathIsEmpty request && requestMethod request == methodGet = do
274 e <- runEitherT action
275 e <- runEitherT action
@@ -308,8 +309,8 @@ instance ( AllCTRender ctypes a
308instance (KnownSymbol sym, FromText a, HasServer sublayout)
309instance (KnownSymbol sym, FromText a, HasServer sublayout)
309 => HasServer (Header sym a :> sublayout) where
310 => HasServer (Header sym a :> sublayout) where
311− type Server (Header sym a :> sublayout) =
312+ type ServerT (Header sym a :> sublayout) m =
312− Maybe a -> Server sublayout
313+ Maybe a -> ServerT sublayout m
314 route Proxy subserver request respond = do
315 route Proxy subserver request respond = do
315 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
316 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
@@ -332,7 +333,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
333instance ( AllCTRender ctypes a
334instance ( AllCTRender ctypes a
334 ) => HasServer (Post ctypes a) where
335 ) => HasServer (Post ctypes a) where
335− type Server (Post ctypes a) = EitherT (Int, String) IO a
336+ type ServerT (Post ctypes a) m = m a
337 route Proxy action request respond
338 route Proxy action request respond
338 | pathIsEmpty request && requestMethod request == methodPost = do
339 | pathIsEmpty request && requestMethod request == methodPost = do
@@ -365,7 +366,7 @@ instance ( AllCTRender ctypes a
366instance ( AllCTRender ctypes a
367instance ( AllCTRender ctypes a
367 ) => HasServer (Put ctypes a) where
368 ) => HasServer (Put ctypes a) where
368− type Server (Put ctypes a) = EitherT (Int, String) IO a
369+ type ServerT (Put ctypes a) m = m a
370 route Proxy action request respond
371 route Proxy action request respond
371 | pathIsEmpty request && requestMethod request == methodPut = do
372 | pathIsEmpty request && requestMethod request == methodPut = do
@@ -398,7 +399,7 @@ instance ( AllCTRender ctypes a
398instance ( AllCTRender ctypes a
399instance ( AllCTRender ctypes a
399 , Typeable a
400 , Typeable a
400 , ToJSON a) => HasServer (Patch ctypes a) where
401 , ToJSON a) => HasServer (Patch ctypes a) where
401− type Server (Patch ctypes a) = EitherT (Int, String) IO a
402+ type ServerT (Patch ctypes a) m = m a
403 route Proxy action request respond
404 route Proxy action request respond
404 | pathIsEmpty request && requestMethod request == methodPost = do
405 | pathIsEmpty request && requestMethod request == methodPost = do
@@ -442,8 +443,8 @@ instance ( AllCTRender ctypes a
442instance (KnownSymbol sym, FromText a, HasServer sublayout)
443instance (KnownSymbol sym, FromText a, HasServer sublayout)
443 => HasServer (QueryParam sym a :> sublayout) where
444 => HasServer (QueryParam sym a :> sublayout) where
445− type Server (QueryParam sym a :> sublayout) =
446+ type ServerT (QueryParam sym a :> sublayout) m =
446− Maybe a -> Server sublayout
447+ Maybe a -> ServerT sublayout m
448 route Proxy subserver request respond = do
449 route Proxy subserver request respond = do
449 let querytext = parseQueryText $ rawQueryString request
450 let querytext = parseQueryText $ rawQueryString request
@@ -480,8 +481,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
480instance (KnownSymbol sym, FromText a, HasServer sublayout)
481instance (KnownSymbol sym, FromText a, HasServer sublayout)
481 => HasServer (QueryParams sym a :> sublayout) where
482 => HasServer (QueryParams sym a :> sublayout) where
483− type Server (QueryParams sym a :> sublayout) =
484+ type ServerT (QueryParams sym a :> sublayout) m =
484− [a] -> Server sublayout
485+ [a] -> ServerT sublayout m
486 route Proxy subserver request respond = do
487 route Proxy subserver request respond = do
487 let querytext = parseQueryText $ rawQueryString request
488 let querytext = parseQueryText $ rawQueryString request
@@ -513,8 +514,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
513instance (KnownSymbol sym, HasServer sublayout)
514instance (KnownSymbol sym, HasServer sublayout)
514 => HasServer (QueryFlag sym :> sublayout) where
515 => HasServer (QueryFlag sym :> sublayout) where
516− type Server (QueryFlag sym :> sublayout) =
517+ type ServerT (QueryFlag sym :> sublayout) m =
517− Bool -> Server sublayout
518+ Bool -> ServerT sublayout m
519 route Proxy subserver request respond = do
520 route Proxy subserver request respond = do
520 let querytext = parseQueryText $ rawQueryString request
521 let querytext = parseQueryText $ rawQueryString request
@@ -556,8 +557,8 @@ parseMatrixText = parseQueryText
556instance (KnownSymbol sym, FromText a, HasServer sublayout)
557instance (KnownSymbol sym, FromText a, HasServer sublayout)
557 => HasServer (MatrixParam sym a :> sublayout) where
558 => HasServer (MatrixParam sym a :> sublayout) where
559− type Server (MatrixParam sym a :> sublayout) =
560+ type ServerT (MatrixParam sym a :> sublayout) m =
560− Maybe a -> Server sublayout
561+ Maybe a -> ServerT sublayout m
562 route Proxy subserver request respond = case parsePathInfo request of
563 route Proxy subserver request respond = case parsePathInfo request of
563 (first : _)
564 (first : _)
@@ -594,8 +595,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
594instance (KnownSymbol sym, FromText a, HasServer sublayout)
595instance (KnownSymbol sym, FromText a, HasServer sublayout)
595 => HasServer (MatrixParams sym a :> sublayout) where
596 => HasServer (MatrixParams sym a :> sublayout) where
597− type Server (MatrixParams sym a :> sublayout) =
598+ type ServerT (MatrixParams sym a :> sublayout) m =
598− [a] -> Server sublayout
599+ [a] -> ServerT sublayout m
600 route Proxy subserver request respond = case parsePathInfo request of
601 route Proxy subserver request respond = case parsePathInfo request of
601 (first : _)
602 (first : _)
@@ -628,8 +629,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
628instance (KnownSymbol sym, HasServer sublayout)
629instance (KnownSymbol sym, HasServer sublayout)
629 => HasServer (MatrixFlag sym :> sublayout) where
630 => HasServer (MatrixFlag sym :> sublayout) where
631− type Server (MatrixFlag sym :> sublayout) =
632+ type ServerT (MatrixFlag sym :> sublayout) m =
632− Bool -> Server sublayout
633+ Bool -> ServerT sublayout m
634 route Proxy subserver request respond = case parsePathInfo request of
635 route Proxy subserver request respond = case parsePathInfo request of
635 (first : _)
636 (first : _)
@@ -656,7 +657,7 @@ instance (KnownSymbol sym, HasServer sublayout)
656-- > server :: Server MyApi
657-- > server :: Server MyApi
657-- > server = serveDirectory "/var/www/images"
658-- > server = serveDirectory "/var/www/images"
658instance HasServer Raw where
659instance HasServer Raw where
659− type Server Raw = Application
660+ type ServerT Raw m = Application
660 route Proxy rawApplication request respond =
661 route Proxy rawApplication request respond =
661 rawApplication request (respond . succeedWith)
662 rawApplication request (respond . succeedWith)
@@ -683,8 +684,8 @@ instance HasServer Raw where
683instance ( AllCTUnrender list a, HasServer sublayout
684instance ( AllCTUnrender list a, HasServer sublayout
684 ) => HasServer (ReqBody list a :> sublayout) where
685 ) => HasServer (ReqBody list a :> sublayout) where
686− type Server (ReqBody list a :> sublayout) =
687+ type ServerT (ReqBody list a :> sublayout) m =
687− a -> Server sublayout
688+ a -> ServerT sublayout m
689 route Proxy subserver request respond = do
690 route Proxy subserver request respond = do
690 -- See HTTP RFC 2616, section 7.2.1
691 -- See HTTP RFC 2616, section 7.2.1
@@ -703,7 +704,7 @@ instance ( AllCTUnrender list a, HasServer sublayout
703-- | Make sure the incoming request starts with @"/path"@, strip it and
704-- | Make sure the incoming request starts with @"/path"@, strip it and
704-- pass the rest of the request path to @sublayout@.
705-- pass the rest of the request path to @sublayout@.
705instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
706instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
706− type Server (path :> sublayout) = Server sublayout
707+ type ServerT (path :> sublayout) m = ServerT sublayout m
707 route Proxy subserver request respond = case processedPathInfo request of
708 route Proxy subserver request respond = case processedPathInfo request of
708 (first : rest)
709 (first : rest)
709 | first == cs (symbolVal proxyPath)
710 | first == cs (symbolVal proxyPath)