From 09df930de3e438f4600a38960bed7377915d3ba0 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 17 Dec 2014 17:58:19 +0200 Subject: [PATCH] monad-control 1.0 --- yesod-core/ChangeLog.md | 4 ++++ yesod-core/Yesod/Core/Handler.hs | 4 ++-- yesod-core/Yesod/Core/Types.hs | 17 +++++++++++++++++ yesod-core/yesod-core.cabal | 4 ++-- yesod/yesod.cabal | 8 ++++---- 5 files changed, 29 insertions(+), 8 deletions(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index 8d007ba7..c4bd2b17 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.6.2 + +monad-control 1.0 + ## 1.4.6 Added the `Yesod.Core.Unsafe` module. diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 724e1f85..2aa1869f 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -567,7 +567,7 @@ sendRawResponseNoConduit => (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ()) -> m a sendRawResponseNoConduit raw = control $ \runInIO -> - runInIO $ sendWaiResponse $ flip W.responseRaw fallback + liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback $ \src sink -> runInIO (raw src sink) >> return () where fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")] @@ -582,7 +582,7 @@ sendRawResponse :: (MonadHandler m, MonadBaseControl IO m) => (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ()) -> m a sendRawResponse raw = control $ \runInIO -> - runInIO $ sendWaiResponse $ flip W.responseRaw fallback + liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback $ \src sink -> runInIO (raw (src' src) (CL.mapM_ sink)) >> return () where fallback = W.responseLBS H.status500 [("Content-Type", "text/plain")] diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index db59a2d7..76befe10 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -396,12 +396,21 @@ instance MonadIO m => MonadIO (WidgetT site m) where instance MonadBase b m => MonadBase b (WidgetT site m) where liftBase = WidgetT . const . liftBase . fmap (, mempty) instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where +#if MIN_VERSION_monad_control(1,0,0) + type StM (WidgetT site m) a = StM m (a, GWData (Route site)) + liftBaseWith f = WidgetT $ \reader' -> + liftBaseWith $ \runInBase -> + liftM (\x -> (x, mempty)) + (f $ runInBase . flip unWidgetT reader') + restoreM = WidgetT . const . restoreM +#else data StM (WidgetT site m) a = StW (StM m (a, GWData (Route site))) liftBaseWith f = WidgetT $ \reader' -> liftBaseWith $ \runInBase -> liftM (\x -> (x, mempty)) (f $ liftM StW . runInBase . flip unWidgetT reader') restoreM (StW base) = WidgetT $ const $ restoreM base +#endif instance Monad m => MonadReader site (WidgetT site m) where ask = WidgetT $ \hd -> return (rheSite $ handlerEnv hd, mempty) local f (WidgetT g) = WidgetT $ \hd -> g hd @@ -481,11 +490,19 @@ instance Monad m => MonadReader site (HandlerT site m) where -- \"Control.Monad.Trans.Resource.register\': The mutable state is being accessed -- after cleanup. Please contact the maintainers.\" instance MonadBaseControl b m => MonadBaseControl b (HandlerT site m) where +#if MIN_VERSION_monad_control(1,0,0) + type StM (HandlerT site m) a = StM m a + liftBaseWith f = HandlerT $ \reader' -> + liftBaseWith $ \runInBase -> + f $ runInBase . (\(HandlerT r) -> r reader') + restoreM = HandlerT . const . restoreM +#else data StM (HandlerT site m) a = StH (StM m a) liftBaseWith f = HandlerT $ \reader' -> liftBaseWith $ \runInBase -> f $ liftM StH . runInBase . (\(HandlerT r) -> r reader') restoreM (StH base) = HandlerT $ const $ restoreM base +#endif instance MonadThrow m => MonadThrow (HandlerT site m) where throwM = lift . monadThrow diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index a4018321..19b018c5 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.6.1 +version: 1.4.6.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -40,7 +40,7 @@ library , old-locale >= 1.0.0.2 && < 1.1 , containers >= 0.2 , unordered-containers >= 0.2 - , monad-control >= 0.3 && < 0.4 + , monad-control >= 0.3 && < 1.1 , transformers-base >= 0.4 , cookie >= 0.4.1 && < 0.5 , http-types >= 0.7 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 79446cfd..1de74693 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,17 +1,17 @@ name: yesod -version: 1.4.1.1 +version: 1.4.1.2 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Creation of type-safe, RESTful web applications. -description: See README.md +description: Hackage documentation generation is not reliable. For up to date documentation, please see: . category: Web, Yesod stability: Stable cabal-version: >= 1.6 build-type: Simple homepage: http://www.yesodweb.com/ -extra-source-files: README.md +extra-source-files: README.md ChangeLog.md library if os(windows) @@ -22,7 +22,7 @@ library , yesod-auth >= 1.4 && < 1.5 , yesod-persistent >= 1.4 && < 1.5 , yesod-form >= 1.4 && < 1.5 - , monad-control >= 0.3 && < 0.4 + , monad-control >= 0.3 && < 1.1 , transformers >= 0.2.2 , wai >= 1.3 , wai-extra >= 1.3