git.iko.soy/servant
on master help sign in
Expose ResourceT, fix the test
2caabadOleg Grenrus
servant-server/src/Servant/Server/Internal.hs+3−2
compare with master
unifiedsplit
@@ -24,6 +24,7 @@ module Servant.Server.Internal
24 ) where
24 ) where
25
25
26import Control.Monad.Trans (liftIO)
26import Control.Monad.Trans (liftIO)
27+import Control.Monad.Trans.Resource (runResourceT)
27import qualified Data.ByteString as B
28import qualified Data.ByteString as B
28import qualified Data.ByteString.Char8 as BC8
29import qualified Data.ByteString.Char8 as BC8
29import qualified Data.ByteString.Lazy as BL
30import qualified Data.ByteString.Lazy as BL
@@ -399,12 +400,12 @@ instance HasServer Raw context where
399
400
400 type ServerT Raw m = Application
401 type ServerT Raw m = Application
401
402
402− route Proxy _ rawApplication = RawRouter $ \ env request respond -> do
403+ route Proxy _ rawApplication = RawRouter $ \ env request respond -> runResourceT $ do
403 -- note: a Raw application doesn't register any cleanup
404 -- note: a Raw application doesn't register any cleanup
404 -- but for the sake of consistency, we nonetheless run
405 -- but for the sake of consistency, we nonetheless run
405 -- the cleanup once its done
406 -- the cleanup once its done
406 r <- runDelayed rawApplication env request
407 r <- runDelayed rawApplication env request
407− go r request respond
408+ liftIO $ go r request respond
408
409
409 where go r request respond = case r of
410 where go r request respond = case r of
410 Route app -> app request (respond . Route)
411 Route app -> app request (respond . Route)
servant-server/src/Servant/Server/Internal/RoutingApplication.hs+7−7
@@ -21,7 +21,7 @@ import Control.Monad.Reader (MonadReader (..), ReaderT,
21import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
21import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
22import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
22import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
23 defaultLiftBaseWith, defaultRestoreM)
23 defaultLiftBaseWith, defaultRestoreM)
24−import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT)
24+import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT)
25import Network.Wai (Application, Request, Response, ResponseReceived)
25import Network.Wai (Application, Request, Response, ResponseReceived)
26import Prelude ()
26import Prelude ()
27import Prelude.Compat
27import Prelude.Compat
@@ -197,8 +197,8 @@ instance MonadBaseControl IO DelayedIO where
197 liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
197 liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
198 restoreM = DelayedIO . restoreM
198 restoreM = DelayedIO . restoreM
199
199
200−runDelayedIO :: DelayedIO a -> Request -> IO (RouteResult a)
200+runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
201−runDelayedIO m req = runRouteResultT $ runResourceT $ runReaderT (runDelayedIO' m) req
201+runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req
202
202
203-- | A 'Delayed' without any stored checks.
203-- | A 'Delayed' without any stored checks.
204emptyDelayed :: RouteResult a -> Delayed env a
204emptyDelayed :: RouteResult a -> Delayed env a
@@ -303,7 +303,7 @@ passToServer Delayed{..} x =
303runDelayed :: Delayed env a
303runDelayed :: Delayed env a
304 -> env
304 -> env
305 -> Request
305 -> Request
306− -> IO (RouteResult a)
306+ -> ResourceT IO (RouteResult a)
307runDelayed Delayed{..} env req =
307runDelayed Delayed{..} env req =
308 runDelayedIO
308 runDelayedIO
309 (do c <- capturesD env
309 (do c <- capturesD env
@@ -325,12 +325,12 @@ runAction :: Delayed env (Handler a)
325 -> (RouteResult Response -> IO r)
325 -> (RouteResult Response -> IO r)
326 -> (a -> RouteResult Response)
326 -> (a -> RouteResult Response)
327 -> IO r
327 -> IO r
328−runAction action env req respond k = do
328+runAction action env req respond k = runResourceT $ do
329− runDelayed action env req >>= go >>= respond
329+ runDelayed action env req >>= go >>= liftIO . respond
330 where
330 where
331 go (Fail e) = return $ Fail e
331 go (Fail e) = return $ Fail e
332 go (FailFatal e) = return $ FailFatal e
332 go (FailFatal e) = return $ FailFatal e
333− go (Route a) = do
333+ go (Route a) = liftIO $ do
334 e <- runHandler a
334 e <- runHandler a
335 case e of
335 case e of
336 Left err -> return . Route $ responseServantErr err
336 Left err -> return . Route $ responseServantErr err