git.iko.soy/servant
on master help sign in
Expose ResourceT, fix the test
commit2caabad61a25884477eb76019c09ed46e5845884 authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 18 Jan 2017, 12:25 (10 years ago) parent091f6f4
2 files changed+10−9
compare with master
unifiedsplit
servant-server/src/Servant/Server/Internal.hs+3−2 servant-server/src/Servant/Server/Internal/RoutingApplication.hs+7−7
servant-server/src/Servant/Server/Internal.hs+3−2
@@ -24,6 +24,7 @@ module Servant.Server.Internal
2424 ) where
2525
2626import Control.Monad.Trans (liftIO)
27+import Control.Monad.Trans.Resource (runResourceT)
2728import qualified Data.ByteString as B
2829import qualified Data.ByteString.Char8 as BC8
2930import qualified Data.ByteString.Lazy as BL
@@ -399,12 +400,12 @@ instance HasServer Raw context where
399400
400401 type ServerT Raw m = Application
401402
402− route Proxy _ rawApplication = RawRouter $ \ env request respond -> do
403+ route Proxy _ rawApplication = RawRouter $ \ env request respond -> runResourceT $ do
403404 -- note: a Raw application doesn't register any cleanup
404405 -- but for the sake of consistency, we nonetheless run
405406 -- the cleanup once its done
406407 r <- runDelayed rawApplication env request
407− go r request respond
408+ liftIO $ go r request respond
408409
409410 where go r request respond = case r of
410411 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,
2121import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
2222import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
2323 defaultLiftBaseWith, defaultRestoreM)
24−import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT)
24+import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT)
2525import Network.Wai (Application, Request, Response, ResponseReceived)
2626import Prelude ()
2727import Prelude.Compat
@@ -197,8 +197,8 @@ instance MonadBaseControl IO DelayedIO where
197197 liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
198198 restoreM = DelayedIO . restoreM
199199
200−runDelayedIO :: DelayedIO a -> Request -> IO (RouteResult a)
201−runDelayedIO m req = runRouteResultT $ runResourceT $ runReaderT (runDelayedIO' m) req
200+runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
201+runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req
202202
203203-- | A 'Delayed' without any stored checks.
204204emptyDelayed :: RouteResult a -> Delayed env a
@@ -303,7 +303,7 @@ passToServer Delayed{..} x =
303303runDelayed :: Delayed env a
304304 -> env
305305 -> Request
306− -> IO (RouteResult a)
306+ -> ResourceT IO (RouteResult a)
307307runDelayed Delayed{..} env req =
308308 runDelayedIO
309309 (do c <- capturesD env
@@ -325,12 +325,12 @@ runAction :: Delayed env (Handler a)
325325 -> (RouteResult Response -> IO r)
326326 -> (a -> RouteResult Response)
327327 -> IO r
328−runAction action env req respond k = do
329− runDelayed action env req >>= go >>= respond
328+runAction action env req respond k = runResourceT $ do
329+ runDelayed action env req >>= go >>= liftIO . respond
330330 where
331331 go (Fail e) = return $ Fail e
332332 go (FailFatal e) = return $ FailFatal e
333− go (Route a) = do
333+ go (Route a) = liftIO $ do
334334 e <- runHandler a
335335 case e of
336336 Left err -> return . Route $ responseServantErr err