on master help sign in
Merge pull request #21 from rschatz/master

Support other monads than just IO.

commit1b61455d2b62820e25e0ff8d0f3d995907cc8ad0 authorJulian Arni <jkarni@gmail.com> dateTue 10 Mar 2015, 18:51 (12 years ago) parent947815ef7af3b1
2 files changed+29−27
src/Servant/Server.hs+1 src/Servant/Server/Internal.hs+28−27
src/Servant/Server.hs+1
@@ -12,6 +12,7 @@ module Servant.Server
1212
1313 , -- * Handlers for all standard combinators
1414 HasServer(..)
15+ , Server
1516 ) where
1617
1718import Data.Proxy (Proxy)
src/Servant/Server/Internal.hs+28−27
@@ -160,9 +160,10 @@ processedPathInfo r =
160160 where pinfo = parsePathInfo r
161161
162162class HasServer layout where
163− type Server layout :: *
163+ type ServerT layout (m :: * -> *) :: *
164164 route :: Proxy layout -> Server layout -> RoutingApplication
165165
166+type Server layout = ServerT layout (EitherT (Int, String) IO)
166167
167168
168169-- * Instances
@@ -179,7 +180,7 @@ class HasServer layout where
179180-- > where listAllBooks = ...
180181-- > postBook book = ...
181182instance (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
183184 route Proxy (a :<|> b) request respond =
184185 route pa a request $ \ mResponse ->
185186 if isMismatch mResponse
@@ -212,8 +213,8 @@ captured _ = fromText
212213instance (KnownSymbol capture, FromText a, HasServer sublayout)
213214 => HasServer (Capture capture a :> sublayout) where
214215
215− type Server (Capture capture a :> sublayout) =
216− a -> Server sublayout
216+ type ServerT (Capture capture a :> sublayout) m =
217+ a -> ServerT sublayout m
217218
218219 route Proxy subserver request respond = case processedPathInfo request of
219220 (first : rest)
@@ -239,7 +240,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
239240-- painlessly error out if the conditions for a successful deletion
240241-- are not met.
241242instance HasServer Delete where
242− type Server Delete = EitherT (Int, String) IO ()
243+ type ServerT Delete m = m ()
243244
244245 route Proxy action request respond
245246 | pathIsEmpty request && requestMethod request == methodDelete = do
@@ -268,7 +269,7 @@ instance HasServer Delete where
268269-- list.
269270instance ( AllCTRender ctypes a
270271 ) => 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
272273 route Proxy action request respond
273274 | pathIsEmpty request && requestMethod request == methodGet = do
274275 e <- runEitherT action
@@ -308,8 +309,8 @@ instance ( AllCTRender ctypes a
308309instance (KnownSymbol sym, FromText a, HasServer sublayout)
309310 => HasServer (Header sym a :> sublayout) where
310311
311− type Server (Header sym a :> sublayout) =
312− Maybe a -> Server sublayout
312+ type ServerT (Header sym a :> sublayout) m =
313+ Maybe a -> ServerT sublayout m
313314
314315 route Proxy subserver request respond = do
315316 let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
@@ -332,7 +333,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
332333-- list.
333334instance ( AllCTRender ctypes a
334335 ) => 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
336337
337338 route Proxy action request respond
338339 | pathIsEmpty request && requestMethod request == methodPost = do
@@ -365,7 +366,7 @@ instance ( AllCTRender ctypes a
365366-- list.
366367instance ( AllCTRender ctypes a
367368 ) => 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
369370
370371 route Proxy action request respond
371372 | pathIsEmpty request && requestMethod request == methodPut = do
@@ -398,7 +399,7 @@ instance ( AllCTRender ctypes a
398399instance ( AllCTRender ctypes a
399400 , Typeable a
400401 , 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
402403
403404 route Proxy action request respond
404405 | pathIsEmpty request && requestMethod request == methodPost = do
@@ -442,8 +443,8 @@ instance ( AllCTRender ctypes a
442443instance (KnownSymbol sym, FromText a, HasServer sublayout)
443444 => HasServer (QueryParam sym a :> sublayout) where
444445
445− type Server (QueryParam sym a :> sublayout) =
446− Maybe a -> Server sublayout
446+ type ServerT (QueryParam sym a :> sublayout) m =
447+ Maybe a -> ServerT sublayout m
447448
448449 route Proxy subserver request respond = do
449450 let querytext = parseQueryText $ rawQueryString request
@@ -480,8 +481,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
480481instance (KnownSymbol sym, FromText a, HasServer sublayout)
481482 => HasServer (QueryParams sym a :> sublayout) where
482483
483− type Server (QueryParams sym a :> sublayout) =
484− [a] -> Server sublayout
484+ type ServerT (QueryParams sym a :> sublayout) m =
485+ [a] -> ServerT sublayout m
485486
486487 route Proxy subserver request respond = do
487488 let querytext = parseQueryText $ rawQueryString request
@@ -513,8 +514,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
513514instance (KnownSymbol sym, HasServer sublayout)
514515 => HasServer (QueryFlag sym :> sublayout) where
515516
516− type Server (QueryFlag sym :> sublayout) =
517− Bool -> Server sublayout
517+ type ServerT (QueryFlag sym :> sublayout) m =
518+ Bool -> ServerT sublayout m
518519
519520 route Proxy subserver request respond = do
520521 let querytext = parseQueryText $ rawQueryString request
@@ -556,8 +557,8 @@ parseMatrixText = parseQueryText
556557instance (KnownSymbol sym, FromText a, HasServer sublayout)
557558 => HasServer (MatrixParam sym a :> sublayout) where
558559
559− type Server (MatrixParam sym a :> sublayout) =
560− Maybe a -> Server sublayout
560+ type ServerT (MatrixParam sym a :> sublayout) m =
561+ Maybe a -> ServerT sublayout m
561562
562563 route Proxy subserver request respond = case parsePathInfo request of
563564 (first : _)
@@ -594,8 +595,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
594595instance (KnownSymbol sym, FromText a, HasServer sublayout)
595596 => HasServer (MatrixParams sym a :> sublayout) where
596597
597− type Server (MatrixParams sym a :> sublayout) =
598− [a] -> Server sublayout
598+ type ServerT (MatrixParams sym a :> sublayout) m =
599+ [a] -> ServerT sublayout m
599600
600601 route Proxy subserver request respond = case parsePathInfo request of
601602 (first : _)
@@ -628,8 +629,8 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
628629instance (KnownSymbol sym, HasServer sublayout)
629630 => HasServer (MatrixFlag sym :> sublayout) where
630631
631− type Server (MatrixFlag sym :> sublayout) =
632− Bool -> Server sublayout
632+ type ServerT (MatrixFlag sym :> sublayout) m =
633+ Bool -> ServerT sublayout m
633634
634635 route Proxy subserver request respond = case parsePathInfo request of
635636 (first : _)
@@ -656,7 +657,7 @@ instance (KnownSymbol sym, HasServer sublayout)
656657-- > server :: Server MyApi
657658-- > server = serveDirectory "/var/www/images"
658659instance HasServer Raw where
659− type Server Raw = Application
660+ type ServerT Raw m = Application
660661 route Proxy rawApplication request respond =
661662 rawApplication request (respond . succeedWith)
662663
@@ -683,8 +684,8 @@ instance HasServer Raw where
683684instance ( AllCTUnrender list a, HasServer sublayout
684685 ) => HasServer (ReqBody list a :> sublayout) where
685686
686− type Server (ReqBody list a :> sublayout) =
687− a -> Server sublayout
687+ type ServerT (ReqBody list a :> sublayout) m =
688+ a -> ServerT sublayout m
688689
689690 route Proxy subserver request respond = do
690691 -- See HTTP RFC 2616, section 7.2.1
@@ -703,7 +704,7 @@ instance ( AllCTUnrender list a, HasServer sublayout
703704-- | Make sure the incoming request starts with @"/path"@, strip it and
704705-- pass the rest of the request path to @sublayout@.
705706instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
706− type Server (path :> sublayout) = Server sublayout
707+ type ServerT (path :> sublayout) m = ServerT sublayout m
707708 route Proxy subserver request respond = case processedPathInfo request of
708709 (first : rest)
709710 | first == cs (symbolVal proxyPath)